perm filename SMTPSR.FAI[S,NET]11 blob sn#736792 filedate 1983-12-12 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00043 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00010 00002	 history FLG A B C D E F FLG2 MBP MCH MSJ T T1 T2 T3 P PDLL PDL DIBUF DOBUF FOBUF FIBUF IBUF OBUF ICPBLK ICPSTS ICPSKT HOSTNO CONECB CNIBTS HSTSTR PRIVS UFDFIL PASMTA PRVMTA PRVBUF PASWD PRIVWD GRPWD maxpth REVPTH MFRBUF MSJBUF SNDNAM XRFBUF XRFBZZ XRFBBP XRRBBP XXBUF XXBZZ XXBBP NBUFS DSKIBF DSKOBF MFDIBF OLDIBF LOURH3 OURH3 LCSS LCRS FCSS FCRS LDSS LDRS FDRS FDSS UPPN ALIPPN UPRG PPNTMP PASTRY SILENT DOMODE DIMODE DOTYPE DITYPE IMODES FMODES DOBS DIBS DOACTV DIACTV XACTV RTYPE RBS SCHEKF OUTINSTR SYNCH DIRFLC PATCH IMP DIMP DOMP FIMP FOMP .MFD .OLD .PASS UFDC MEOFBT USREBT PASSBT MFRWIN MFRLUZ MFRDUN MFNMF LFSEEN LISTFL MSJDUN MSJWIN MSJLUZ MSJDUN QUOTEF LEFTF .MAIL .XSEN .XSEM .XMAS CPOPJ2 POPJ1 CPOPJ1 CPOPJ REPMET QUANTM REAPRV WRTPRV MASPRV SYSPRV SCYPRV DECPRV ACTPRV CSPPRV GROUPS WAITST WATSIT
C00030 00003		DEFINITIONS OF A "GLOBAL" NATURE
C00033 00004	ICP ICPCHK ICPX ICPTO KFLAG ICPGTO ICPSTO
C00037 00005	IDCON IDCONZ IDCONI IDCNFI IDCNFO IDCNFX IDCNQ1 IDCNQ2 IDCONW IDCONC IDCONX IDCONY IDCONS IDCONB IDCONP IDCOND IDCONF IDSOCS IDSOCK IDSOC0 IDSOC1 IDSOC2
C00043 00006	ILDDEV ILDSTT DPBIT ILDDO NOOPEN ILDVCH ILDVC1 ILDVC2 NOUFDC ACCOK ILDL69 ILDDL1 ILDDL ILDDE0 ILDDET ILDE69 ILDDE1 ILDDE ILDDUG ILDDD ILDDRN ASSHOL ILD123 ILDD ILDSS1 ILDSS2 ACCCHK OWNACC GRPCHK
C00055 00007	 START %SITE% REGO
C00062 00008	LOOP SCHEK STATUS
C00064 00009	SAVACX SAVACS GETACS
C00066 00010	CIDISP CIREEN CIWAIT CIWAIX CIACS CIP CIP1 CIHUNG CIPDL DIDISP DIREEN DIWAIT DIACS DIP DIP1 DIHUNG DIPDL DODISP DOREEN DOWAIT DOACS DOP DOP1 DOHUNG DOPDL
C00069 00011	CIROUT COMDIS BADCOM
C00070 00012	APPE STOR WAITIL GETSET GETSE1 GETSEL C2 GETSEA MLFL STORX3 STORX0 STOR1 RETRX1 STORX1 ILDERR ILDER1 STOMES ERRNUM ERRNM1 TYPNAM ERRTXT ERRTX1 TYPDSP ERRPP ERRPP1 ERRPP2 ERRMF ERRMF1 ERRFN ERRFN1
C00083 00013	RNFR DELE GCRNTO RENFIL RNMOK RELDMP RNTO BADTO BDTONM BADDRN ALLO
C00086 00014	 HELO HELOLP NOOP NOFROM RCPT RCPTML RCPTCL RCPTX SYNERR NORLAY XSEN XSEM XMAS MAIL MAILCM MAILER GETFRM GETFRL GETFRS GETFNQ GETFRE GETFRX OK250 NODEST DATA NMAIL MAILIN NODOT EOMAIL MAIL91 SETMFL RMDLK RMDAOS RMDFIL WRHDR WHDFRB WSCRLF WHDFRM RCDCR WRTSSP WRTSS1 WRTSTR WRTST1 WRTST2 wrtsix wrlp wrsoj SWRTCH WRTCHR CORERR IERR4 HELP NOMAIL NOUSER SYNER2 SENERR NOPPNM RCVD DAYLIT MAISTR MAIST2 MAIDEC MAI2DG
C00107 00015	SEND LOGGED LOGGE1 LOGTST JBLP JBNXT SENDER JUSTEL MSPG MSNFR MSNSJ SENTTY DPBSTR DPBNAM MSBUFR
C00111 00016	VALID VALCL1 MFDLP MFDLP1 VWINS VLDONE GETMFD GTM1CH MFDIN MFDIN1 VTRYFT MOPEN MBUF MFDNAM MFDNAM NOMFD VSXCHR VALFIL VALFPP
C00116 00017	MFRINI MFRCHR MFRSTR MFRING MFRQTE MFROVR
C00119 00018	MSJINI MSJCHR MSJSTR MSJING MSJQTE MSJOVR
C00122 00019	NLST LIST STAT STAT1 STAT2 REJOIN STDONE LIDONE STWILD STWLP STWLP1 DOSTAT STATLP STALP1 STALP2 STAPOK NXTFL1 NXTFL2 NXTFIL STATEOF STATERR STAPRO LISTIT LISTI1 PUT1 PUT6 PUT61 PUT62 sixwrt wrlp wrsoj STATDO
C00132 00020	RETR RETRX0 ASCERR
C00134 00021	WHICHA WHICHB TYPE TYPEUN TYPEOK TYPEGO MODE MODEUN MODEOK STRU XRSQ
C00137 00022	DECIN DECIN0 SOCK
C00139 00023	BYTE BYTE2 BYTE4 BYTE9
C00140 00024	PASS NOPRVS WRONGP GIVUSR MUSTLG PASFOO USER USER3 ASKPAS USER1 USER4 CWD XCWD ACCT INFREE
C00147 00025	GETCOM GETCO1 FLUSCS flcs1 GETCO2
C00150 00026	GETIDX ANAMES
C00151 00027	 PUTCH1 PUTCHR PUTCH2 PUTBUF PUTBU2 PUTBU2 PUTBU3
C00155 00028	 GETCHR RGETCH GETCH1 GETCH6 GETCH7 GETCH2 GETCH3 GETCH4 GETCH5 GETCAP FAKELF
C00159 00029	GSRCI GSR ASCII1 ASCII2 ASCII3 ASCIIY ASCIIE ASCIIC
C00162 00030	 DIMPSTR DOMPSTR IMPSTR IMPSTF IMPST0 IMPSTN IMPST1 IMPST2 IMPCR IMPSTH WATHST MAXSIT WATHS2 IMPOCT
C00166 00031	SIXINL SIXINR SIXIN1 SIXIN2 SIXIN3 SIXIN4
C00169 00032	GFNML GFN GFN0 GFN0A GFN1 GPPN1 GPPN2 GPPN3 GPPN GPPNX GPPWIN GPPFIL MLFLNM MLFLN1 OKMF
C00175 00033	 GETDST MLNCOP MLNB MLNA MLNMIN MLNMOK COPDOM COPHST COPHS2 COPHOK CHKSTR CHKST0 SKPSPC SKPSP0 SKPSPG SKPSGL MLFILE MLNMFF MLNMF2 MLNMF0 MLDOMX MLHOST MLHOSL MLHOS2 POP12J GET0E1 GET0E2 GET0E3 GET0E4 GET0E5 GET0E6 GET0E7 GET010 GET011 GET012 GET013 GET014 GET015 GET016 GET1E1 GET1E2 GET1ER GET0ER MLHDUN TRYFAC FACTLP FACGE1 FACGE2 FACGE3 FACWRD FACTRY FACTST FACLUZ FACEOF FACRGT FACCHR FACCH1 HRPRIM HRLOOP HRDONE NOFACT FACERR UNRECU AMBIG FACBUF NBUFFR NBUFFX DSTHNM DSTHNX FOPEN FACTXT
C00197 00034	TRYFOR TRYFO1 FORLIN FORCHR FORNO FORTEL FORTE1 FORTE2 FOTAB FORCPY FORCP1 FORCP2 FORZIP FORCHG FORTXT
C00202 00035	DIROUT DIROU1 DIROU2 DIRO25 DIROU3 DIERR ICONER DIERR2 DIER2A DIEOF9 DIEOF DIEOFQ DIEOFL DIEOF0 DIEOF1 DIFINI DIEOML DIMLFL DIERR3
C00210 00036	RMDWAK RMDSYS OMLGET OMLGT1 OMLOUT OMLOPN OMLBUF OMLNAM PUTFIL PUTFI0 PUTFI1 PUTFI2 PUTFI3 PUTFI4 PUTFI5 FIBTSL FIWORD FIBPT
C00214 00037	GETDAT GETDA1 GETDA0 GETDA2 GETDA3 GETDA4 GETDA5 GETDA7 GETDAC GETDAE
C00217 00038	DOROUT DOROU1 DOROU2 DOROU3 DOEOF DOEOF1 DOEOF2 DOERR OCONER
C00221 00039	GETFIL GETFI0 GETFI1 GETFI2 GETFI3 GETFI4 GETFI5 GETFI6 GETFI7 GETF71 GETFI8 FOBTSL FOWORD FOBPT FOTEMP FOMASK
C00226 00040	NUMPR NUMPR1 DON0 DATGEN NODA1 ONEDDD NODATE NOTIME NOZON MONTAB PDDATE PSDATE DTKIND
C00229 00041	ILEVEL DNTSAY timout SXACTV LOOK
C00231 00042	 GETHNM CPYHST CPYDUN HSTTAB HSTSIX WHYWHY
C00235 00043	 BYE BYE1 BYE2 ERRKIL QUIT QUIT1 ABOR FLUSH NEWTMO NOIMP UFLUSH GREET GREETL GREET0 NOFLAK GREET1 SAYWHO
C00242 ENDMK
C⊗;
;⊗ history FLG A B C D E F FLG2 MBP MCH MSJ T T1 T2 T3 P PDLL PDL DIBUF DOBUF FOBUF FIBUF IBUF OBUF ICPBLK ICPSTS ICPSKT HOSTNO CONECB CNIBTS HSTSTR PRIVS UFDFIL PASMTA PRVMTA PRVBUF PASWD PRIVWD GRPWD maxpth REVPTH MFRBUF MSJBUF SNDNAM XRFBUF XRFBZZ XRFBBP XRRBBP XXBUF XXBZZ XXBBP NBUFS DSKIBF DSKOBF MFDIBF OLDIBF LOURH3 OURH3 LCSS LCRS FCSS FCRS LDSS LDRS FDRS FDSS UPPN ALIPPN UPRG PPNTMP PASTRY SILENT DOMODE DIMODE DOTYPE DITYPE IMODES FMODES DOBS DIBS DOACTV DIACTV XACTV RTYPE RBS SCHEKF OUTINSTR SYNCH DIRFLC PATCH IMP DIMP DOMP FIMP FOMP .MFD .OLD .PASS UFDC MEOFBT USREBT PASSBT MFRWIN MFRLUZ MFRDUN MFNMF LFSEEN LISTFL MSJDUN MSJWIN MSJLUZ MSJDUN QUOTEF LEFTF .MAIL .XSEN .XSEM .XMAS CPOPJ2 POPJ1 CPOPJ1 CPOPJ REPMET QUANTM REAPRV WRTPRV MASPRV SYSPRV SCYPRV DECPRV ACTPRV CSPPRV GROUPS WAITST WATSIT

TITLE SMTPSR	SMTP server

COMMENT ⊗  History (please record changes):

03 May 83 ME	IP/TCP code under FTIP.
04 May 83 ME	EOMAIL wakes up remind phantom to deliver the mail.
17 May 83 JJW	Fix to convert IP addresses to/from HOSTS2 format.
15 May 83 ME	MLNLFF now checks host name in To: line to see if it's ours.
		Quoting with "\" in From: line works, but leave "\" in line
		for local mail hdr; MAIL should be fixed to accept this
		form in a destination.  RSET cmd clears GOTFRM.  MLNB refuses
		to accept mail for relaying (starts with "@" and contains
		":" or "," -- already refused if contained "@...:").
19 May 83 ME	MLFILE now handles mail to "@file"@ourname correctly.
23 May 83 ME	RCPT checks to see if the user is really logged in for SEND,
		and returns a 450 failure reply if not.
10 Jun 83 ME	Put more specific error replies in MAIL/GETFRM.
11 Jun 83 ME	Conversion to HOSTS3.  Also uses dotted host number string
		if no known host name for given host number.  Allows connection
		if from any of our alias host numbers when system down.  Uses
		exec 355 ptr to our host numbers.
13 Jun 83 ME	Bug fixed at MLHOST, infinite loop resetting aobjn ptr.
23 Jun 83 ME	Turned off "verbose" mode, to speed up I-level.
24 Jun 83 ME	Fixed ILEVEL's verbose mode output buffer check to be more
		conservative to avoid attempt to reschedule at I-level.
04 Jul 83 ME	Fixed SCHEK to check for RFCS and RFCR instead of just CLS bits,
		since a completely closed connection shows no bits at all.
		Separated IVERBOSE from VERBOSE; former causes I-level typeout.
05 Jul 83 ME	Fixed PUTCH2 and GETCH7 to include 32↔33 in ASCII/WAITS
		character conversion (previous done to FTP/FTPSER).
04 Aug 83 ME	SYNERR, NOMAIL and NOUSER errors in recipient include RCPT
		line in error reply.  Fixed START to clear HSTADR in case
		core image is restarted, since JOBFF is reset by RESET, thus
		allowing any mapped in host table's core to be reused and
		hence clobbered.
11 Aug 83 ME	Change NORLAY to return 550 instead of 553 (for no relaying
		implemented), and fixed GETDST to take direct return to
		get to NORLAY if first host name parsed isn't us (implying
		relaying request).
12 Aug 83 ME	IMPSTR fixed not to outstr stuff twice in verbose mode;
		other routines fixed to type out text in verbose mode,
		being more consistent (call PUTCH1 instead of PUTCHR).
		GETDST sets SYNCOD with code of any syntax error; SYNERR
		returns octal error code in SMTP reply.
17 Aug 83 ME	Fixed bug in SYNERR that made it not include error code but
		our host name in the syntax error text.
18 Aug 83 ME	Made SYNERR and GETxEx to report last char plus error code.
19 Aug 83 ME	Fixed DNTSAY (on user interrupt) and GETCH1 not to use SYNCH,
		since SMTP protocol doesn't have DataMarks; the 200 bit must
		be zero.  GET0E6 halts after changing job name to 'GET ME'.
20 Aug 83 ME	MLNMIN accepts "." in mailbox name, in case foreign host
		is sending us a message to be relayed to another host.
		Removed halt at GET0E6 except when A holds zero (null).
22 Aug 83 ME	Fixed GETDST (1) to clear any previous overflow of XRFBUF
		and (2) to zero XRFBBP to stop saving text in XRFBUF after
		recipient line finished at MLNCOP.  This should fix the
		erroneous "syntax error" reply we sometimes have been
		returning (after long msg followed by second msg using
		same connection).
30 Aug 83 ME	Removed halt at GET0E6 for final case (A holds null),
		since the bug was fixed and this halt really happens
		when the foreign mailer has a syntax problem.
16 Sep 83 JJW	Removed FTHST3 switch and non-HOSTS3 code.  Changed failure
		return from HSTNUM to call HNUMST in NETWRK.
26 Oct 83 ME	Made WRHDR use downarrows instead of double quotes to
		quote the "from:" text for local mail header, etc.
		GETFRL maintains spaces, tabs and brackets in name that
		is quoted with double quotes.
7 Dec 83 ME	GETDST fixed partially to allow double quotes around dest
		(to make "@FILE"@SU-AI work).

history:  end of comment ⊗ 
PRINTS /Have you listed your changes at History: on page 2?

/

IFNDEF FTIP,<↓FTIP←←1>		;IP/TCP version
IFE FTIP,<
PRINTS/To put up a new SMTPSR, save core image as RFC031.DMP[NET,SYS].
/
>;IFE FTIP
IFN FTIP,<
PRINTS/To put up a new SMTPSR, save core image as TCP031.DMP[NET,SYS].
/
>;IFN FTIP

IFNDEF FTREQL,<FTREQL←←0>	;set nonzero to require login for main stuff
IFN FTREQL,<PRINTS/Will require login for file operations.
/>

IFNDEF FTPSKT,<FTPSKT←←31>

IFNDEF VERBOSE,<VERBOSE←←0>	;SET TO 0 FOR QUIET
IFNDEF IVERBOSE,<IVERBOSE←←0>	;SET TO 0 FOR QUIET, else typeout at I-level

IFNDEF FTMSJ,<FTMSJ←←0>		;Nonzero means extract subject from mail
				;Zero now to let MAIL program find the subject
IFNDEF FTFRM,<FTFRM←←0>		;Nonzero means extract "from: line" from mail
				;Zero now since SMTP has explicit "from" text

	EXTERN JOBFF,JOBSA

; ACCUMULATOR DEFINITIONS:
	FLG←0		;High order bit for EOF from MAIL command, see below
	↓A←1		;TEMP
	↓B←2		;TEMP
	C←3
	D←4
	E←5
	F←6
	FLG2←7		;USED TO INSERT INITIAL SPACES IN MLFL LINES
IFN FTFRM,<
	MBP←10		;USED FOR MAIL "FROM" LINE FINDER
	MCH←11		;DITTO
>;IFN FTFRM
IFN FTMSJ,<
	MSJ←12		;USED FOR MAIL "SUBJECT" LINE FINDER
>;IFN FTMSJ
	T←13
	↓T1←14
	↓T2←15
	↓T3←16
	↓P←17		;PUSH DOWN LIST

; STORAGE ASSIGNMENTS:
	PDLL←←60	;PDL LENGTH
	PDL:	BLOCK PDLL
	DIBUF:	BLOCK 3	;BUFFER HEADER, INPUT FROM IMP DATA CONNECTION
	DOBUF:	BLOCK 3	;BUFFER HEADER, OUTPUT TO  IMP DATA CONNECTION
	FOBUF:	BLOCK 3	;BUFFER HEADER, INPUT FROM (DSK,MTA,DTA,ETC.)
	FIBUF:	BLOCK 3	;BUFFER HEADER, OUTPUT TO  (DSK,MTA,DTA,ETC.)
	IBUF:	BLOCK 3	;INPUT CONTROL BUFFER HEADER
	OBUF:	BLOCK 3	;OUTPUT CONTROL BUFFER HEADER
	ICPBLK:	1		; LISTEN
	ICPSTS:	0		; status
		FTPSKT		; listen socket
		-1		; wait flag
		=32		; byte size
	ICPSKT:	0		; foreign socket
	HOSTNO:	0		; foreign host
	CONECB:	BLOCK 7
	CNIBTS:	0		;INTERRUPT LEVEL ROUTINES PUTS BITS HERE
	HSTSTR:	BLOCK =10	;HOST STRING
	PRIVS:	0		;SAVE USER'S PRIVILEGES HERE
	UFDFIL:	0
		SIXBIT/UFD/
		0
		SIXBIT/  1  1/
	PASMTA:	SIXBIT/GODMOD/
		15
		0
		0
	PRVMTA:	SIXBIT /GODMOD/
		14
		IOWD 17,PRVBUF
	PRVBUF:	BLOCK 13
	PASWD:	0		;PASSWORD RETURNED HERE IF INF
	PRIVWD:	0		;PRIVILEGES RETURNED HERE
		0		;LAST LOGIN TIME RETURNED HERE
	GRPWD:	0		;GROUP ACCESS BITS RETURNED HERE
maxpth←←=256
	REVPTH:	BLOCK 1+maxpth/5 ;MAIL cmd's argument -- reverse path
IFN FTFRM,<
	MFRBUF:	BLOCK 40	;FOR "FROM" LINE STORAGE (MAIL cmd's argument)
>;IFN FTFRM
IFN FTMSJ,<
	MSJBUF:	BLOCK 40	;FOR "SUBJECT" LINE STORAGE
>;IFN FTMSJ

;;	XRSQSW:	0	; 0 Default scheme, -1 Text-first scheme.
			; +1 Recip-first BH 7/28/80
;;	XRBBEG:	0	; Addr of start of buffer
;;	XRBTOP:	0	; Addr of 1st non-used loc (should be = JOBFF)
;;	XRBPTR:	0	; BP to deposit text at
;;	XRBCNT:	0	; If -, # chars free in buffer, else # chars.
;;MAXRCP←←=100 ;max number of recipients we're supposed to handle
	SNDNAM: BLOCK 1+MAXPTH/5  ;argument of HELO command, sending host's domain&name
	XRFBUF:	BLOCK 1+MAXPTH/5 ; Block for remembering one recipient
	XRFBZZ:	0	; Must stay zero, overflow test
	XRFBBP:	0	; BPT for adding recipient
	XRRBBP:	0	; BPT for re-scanning recipient
	XXBUF:	BLOCK 1+MAXPTH/5 ; Block for remembering one recipient line
	XXBZZ:	0	; Must stay zero, overflow test
	XXBBP:	0	; BPT for adding recipient
;;	XRFOBP:	0	; BPT after last added recipient
;;	XRFHBP:	0	; Copy of OBP as flag for header generation

NBUFS←←23		;optimum number of disk buffers
;I/O BUFFERS
	DSKIBF:	BLOCK NBUFS*203	;A WHOLE TRACK'S WORTH FOR THE MAIN DISK CHANNELS
	DSKOBF:	BLOCK NBUFS*203
	MFDIBF:	BLOCK 2*203	;NOT WORTH IT FOR THESE LOW-USE ONES
	OLDIBF:	BLOCK 2*203

LOURH3←←10		;number of host numbers to allow for ourselves
OURH3:	BLOCK LOURH3	;our host number(s), copied from system via lowcore 355

; VARIABLE DEFINITONS:
	LCSS:	0	;LOCAL CONTROL SEND SOCKET
	LCRS:	0	;LOCAL CONTROL RECEIVE SOCKET
	FCSS:	0	;FOREIGN CONTROL SEND SOCKET
	FCRS:	0	;FOREIGN CONTROL RECEIVE SOCKET
	LDSS:	0	;LOCAL DATA SEND SOCKET
	LDRS:	0	;LOCAL DATA RECEIVE SOCKET
	FDRS:	0	;FOREIGN DATA RECEIVE SOCKET
	FDSS:	0	;FOREIGN DATA SEND SOCKET
	UPPN:	SIXBIT/NETGUE/	;"LOCAL" PPN OF USER FTP
	ALIPPN:	SIXBIT/NETGUE/	;ALIAS PPN OF USER FTP
	UPRG:	'GUE'	;JUST PRG FROM UPPN (FOR CAME IN ILDDEV)
	PPNTMP:	0	;Save user name here until password is given
	PASTRY:	0	;Number of try user has left to guess password
ifn verbose,<
	SILENT:	0	;Hide password from spies running FTPS
>;ifn verbose
	DOMODE:	0	;LEGAL MODES ARE: 0-Stream, 1-Block, 2-Text,
	DIMODE:	0	;  3-Hasp
	DOTYPE:	0	;LEGAL TYPES ARE: 0-Ascii, 1-Image, 2-Local byte,
	DITYPE:	0	;  3-Print file ascii, 4-Ebcdic
	IMODES:	1000 ↔ 1010 ↔ 1010
	FMODES:	1000 ↔ 1010 ↔ 1010
	DOBS:	=8	;BYTE SIZE, DATA CONNECTION OUT
	DIBS:	=8	;BYTE SIZE, DATA CONNECTION IN
	DOACTV:	0	;DATA OUT LINE IS ACTIVE
	DIACTV:	0	;DATA IN  LINE IS ACTIVE
	XACTV:	0
	RTYPE:	0	;REAL TYPE, LATEST GOTTEN FROM USER
	RBS:	=8	;REAL BYTE SIZE, LATEST GOTTEN FROM USER
	SCHEKF:	0	;IF MINUS, IT'S TIME TO CHECK IMP STATUS
	OUTINSTR:0	;FOR DATGEN, WHICH OUTPUT SINK TO WRITE CHARS TO
	SYNCH:	0	;IF +, # OF UNMATCHED DATA MARK CHARS (200)
			;IF -, # OF UNMATCHED INS INTERRUPTS
			;WHILE -, FLUSH ALL INPUT CHARS EXCEPT DM
DIRFLC:	0		;COUNTER FOR FLUSHING EXTRA DIRECTORY ENTRIES

	PATCH:	40	;patch space

; I/O CHANNEL DEFINITONS
	IMP←←4		;CONTROL CONNECTIONS 
	DIMP←←1		;DATA IN FROM IMP CHANNEL
	DOMP←←0		;DATA OUT TO  IMP CHANNEL
	FIMP←←3		;FILE IN (IN FROM IMP, OUT TO DEVICE) CHANNEL
	FOMP←←2		;FILE OUT (OUT TO IMP, IN FROM DEVICE) CHANNEL
;		NOTE:	DIMP,FIMP ARE USED TOGETHER,
;			SIMILARLY, DOMP,FOMP GO TOGETHER
;		SOME OF THE ABOVE ARE USED NON-SYMBOLICALLY IN CODE!!!
	.MFD←←5		;READ MFD FOR VALID MAIL RECIPIENT
	.OLD←←6		;READ OLD MAIL FILE
	.PASS←←7	;USED TO CHECK PASSWORD
	UFDC←←10	;USED TO READ UFD FOR ACCESS CHECK

; FLG bits, left half.
MEOFBT←←1B0		;EOF on MAIL (must be 4.9 bit!)
USREBT←←1B1		;User command given, expecting password
PASSBT←←1B2		;Password given, OK to STOR, etc.
IFN FTFRM,<
MFRWIN←←40000		;MAIL "FROM" LINE FINDER IS ON THE RIGHT LINE
MFRLUZ←←20000		;MAIL "FROM" LINE FINDER IS ON THE WRONG LINE
MFRDUN←←10000		;MAIL "FROM" LINE FINDER IS FINISHED READING IT
>;IFN FTFRM
MFNMF←←4000		;MLFLNM IN PROGRESS
LFSEEN←←2000		;LF HAS BEEN EATEN IN INCOMING COMMAND LINE
LISTFL←←1000		;DO OPERATION IS LIST (OR NLST) AS OPPOSED TO RETR OR STAT
IFN FTMSJ,<
MSJDUN←←400		;MAIL "SUBJECT" LINE FINDER IS FINISHED READING IT
MSJWIN←←200		;MAIL "SUBJECT" LINE FINDER IS ON THE RIGHT LINE
MSJLUZ←←100		;MAIL "SUBJECT" LINE FINDER IS ON THE WRONG LINE
>;IFN FTMSJ
IFE FTMSJ,<
MSJDUN←←0  		;no such bit now
>;IFE FTMSJ
QUOTEF←←40		;QUOTED STRING IN PROGRESS
LEFTF←←20		;LEFT JUSTIFIED SIXBIT
;ABOVE ARE LH FLAGS

.MAIL←←1		;MAIL COMMAND LIKE LOCAL MAIL	(SMTP: MAIL)
.XSEN←←2		;XSEN COMMAND LIKE LOCAL SEND/N (SMTP: SEND)
.XSEM←←4		;XSEM COMMAND LIKE LOCAL SEND/Y (SMTP: SOML)
.XMAS←←10		;XMAS COMMAND LIKE LOCAL SEND/M (SMTP: SAML)
;ABOVE ARE RH FLAGS AND MAYN'T BE MOVED

CPOPJ2:	AOS	(P)
POPJ1:	;I CAN NEVER REMEMBER
CPOPJ1:	AOS	(P)
CPOPJ:	POPJ	P,

DEFINE MES(TEXT) <
	IFN VERBOSE, <OUTSTR	[ASCIZ ⊗TEXT
⊗]		>>

DEFINE REPMES(TEXT) <
	MOVE	E,[POINT 7,[ASCIZ ⊗TEXT
⊗]]
	JRST	REPMET	>
REPMET:	PUSHJ	P,GSRCI
	PUSHJ	P,ASCIIE
	SOS	IMPSTF
	JRST	FLUSCS

QUANTM←←=60		;ONE CLOCK "TICK" IS ONE SECOND

;GROUP ACCESS/PRIVILEGE BITS
;None of these symbols are actually used in the code except GROUPS and MASPRV.
;GROUPS is a fullword value but MASPRV must be right half.

REAPRV←←40000
WRTPRV←←20000
MASPRV←←1
SYSPRV←←2
SCYPRV←←4
DECPRV←←10
ACTPRV←←20
CSPPRV←←40

GROUPS←←47		;ALL OF THE ABOVE.

WAITST:	0		;WAITS site number goes here
WATSIT←←263		;low core location containing WATCPU,,WATSIT
;	DEFINITIONS OF A "GLOBAL" NATURE

ERRBTS ←← 0;

UFDN←←20			;NUMBER OF WORDS IN A DIRECTORY ENTRY

		DEFINE X(BIT,VAL) <
			BIT ← VAL ↔ ERRBTS ← ERRBTS!VAL
				>
IFE FTIP,<
X(RSET,400)	; HOST SEND US A RESET
X(CTROV,1000)	; HOST OVERFLOWED OUR ALLOCATION
X(HDEAD,2000)	; HOST IS DEAD
>;IFE FTIP
X(IODEND,020000); END OF FILE
X(IOBKTL,040000); BLOCK TOO LARGE
X(IODTER,100000); DEVICE ERROR
X(IODERR,200000); DATA ERROR
X(IOIMPM,400000); IMPROPER MODE

RFCS ←← 200000	; RFC SENT
RFCR ←← 100000  ; RFC RECEIVED
CLSS ←← 040000	; CLS SENT
CLSR ←← 020000	; CLS RECEIVED
RFC ←← RFCS ! RFCR
CLS ←← CLSS ! CLSR

STLOC ←← 1
LSLOC ←← 2
WFLOC ←← 3
BSLOC ←← 4
FSLOC ←← 5
HNLOC ←← 6

EXTERNAL JOBCNI,JOBAPR,JOBREL,JOBFF

DEFINE NAMES <
;	X(RNTO)			;MUST BE INDEX 1 WHEN DEFINED
;	X(USER)
;	X(PASS)
;	X(TYPE)
;	X(SOCK)
;	X(STRU)
;	X(MODE)
;	X(BYTE)
;	X(RETR)
;	X(STOR)
;	X(APPE)
;	X(RNFR)
;	X(DELE)
	X(MAIL)
;	X(MLFL)
;	X(STAT)
	X(HELP)
;	X(XCWD)
;	X(CWD)
;	X(BYE)
;	X(ABOR)
;	X(LIST)
;	X(NLST)
	X(SEND,XSEN)		;EXPERIMENTAL, SEND/N
	X(SOML,XSEM)		;EXPERIMENTAL, SEND/Y
	X(SAML,XMAS)		;EXPERIMENTAL, SEND/M
;	X(XRSQ)			; XRCP scheme selection
;	X(XRCP)			; XRCP command itself
;	X(ACCT)
;	X(ALLO)
	X(HELO)
	X(RCPT)		;specifies a recipient
	X(QUIT,BYE)
	X(DATA)
	X(RSET,ABOR)
	X(NOOP)
>

INTINP ←← 000010
INTIMS ←← 000020
INTINS ←← 000040
INTCLK ←← 000200

;OPCODE DEFINITONS:
	DEFINE INTOFF <INTMSK 1,[0]>
	DEFINE INTON  <INTMSK 1,[-1]>
	OPDEF PTOCNT [PTYUUO 3,]
;ICP ICPCHK ICPX ICPTO KFLAG ICPGTO ICPSTO

;	ICP:	INITIAL CONTROL LINK CONNECTION ESTABLISHMENT ROUTINE

ICP:		;THIS ROUTINE ESTABLISHES BOTH CONTROL CONNECTIONS
		;  TO THE USER FTP, AND SKIP RETURNS. NON-SKIP RETURN
		;  INDICATES SOME KIND OF FAILURE.
	MTAPE	IMP,ICPGTO	;GET SYSTEM DEFAULT TIMEOUTS
	MOVE	A,ICPGTO+1	;GET SYSTEM DEFAULT TIMEOUTS IN A
	OR	A,[17,,400000]	;RFC TIMEOUT≥64 SECONDS, ALLOC TIMEOUT ≥30 SEC
	MOVEM	A,ICPSTO+1
	MTAPE	IMP,ICPSTO	;SET TIMEOUTS
IFE FTIP,<
	SETZM	CONECB
	SETZM	CONECB+FSLOC	;DON'T WAIT FOR CONNECTION
>;IFE FTIP
IFN FTIP,<
	MOVEI A,1
	MOVEM A,CONECB		;Do a LISTEN, not a connect
	SETOM CONECB+WFLOC	;Wait for (duplex) connection
	SETZM CONECB+FSLOC	;Listen for any foreign port
	SETZM CONECB+HNLOC	;Any foreign host will do
>;IFN FTIP
	MOVE	A,LCSS
	MOVEM	A,CONECB+LSLOC
IFE FTIP,<
	MOVE	A,FCRS
	MOVEM	A,CONECB+FSLOC
	MOVE	A,HOSTNO
	MOVEM	A,CONECB+HNLOC
>;IFE FTIP
	MOVEI	A,10
	MOVEM	A,CONECB+BSLOC
	MTAPE	IMP,CONECB	;INITIATE CONNECTION OUT
IFN FTIP,<
	MOVE A,CONECB+FSLOC	;get foreign port number
	MOVEM A,FCSS		;new FTP has all foreign port nbrs the same
	MOVEM A,FCRS
	MOVEM A,FDRS
	MOVEM A,FDRS
	MOVE 0,CONECB+HNLOC	;get foreign host number
	MOVEM 0,HOSTNO		;save
>;IFN FTIP

IFE FTIP,<
	MOVE	A,LCRS
	MOVEM	A,CONECB+LSLOC
	MOVE	A,FCSS
	MOVEM	A,CONECB+FSLOC
	MTAPE	IMP,CONECB	;INITIATE CONNECTION IN

	MOVEI	A,4
	MOVEM	A,CONECB
	MOVE	A,LCSS
	MOVEM	A,CONECB+LSLOC
	MTAPE	IMP,CONECB	;WAIT FOR OUT CONNECTION
>;IFE FTIP
	STATZ	IMP,ERRBTS	;TIMEOUT? (OR OTHER RANDOM ERROR)?
	JRST	ICPTO		;  YES

	PUSHJ	P,ICPCHK
IFE FTIP,<
	MOVE	A,LCRS
	MOVEM	A,CONECB+LSLOC
	MTAPE	IMP,CONECB	;WAIT FOR IN CONNECTION
	STATZ	IMP,ERRBTS	;TIMEOUT OR OTHER ERROR?
	 JRST	ICPTO		;  YES
>;IFE FTIP
	JRST	CPOPJ1

ICPCHK:	MOVE	A,CONECB+STLOC
	TRNN	A,-1
	STATZ	IMP,ERRBTS
	JRST	ICPX
	POPJ	P,
ICPX:
IFE FTIP,<
	POP	P,A		;RETURN UPLEVEL ON ERROR
	MES	(Error in control connections)
>;IFE FTIP
IFN FTIP,<
IFN VERBOSE<
	OUTSTR	[ASCIZ/⊗Error in control connections: /]
	MOVE	0,A		;Error code where MTPERR wants it
	PUSHJ	P,MTPERR	;Print error message
>;IFN VERBOSE
	POP	P,A
>;IFN FTIP
	POPJ	P,

ICPTO:		;ICP Time Out
	MES	(ICP times out)
	MOVE	A,['KILL-1']
	MOVEM	A,KFLAG
	JRST	QUIT
KFLAG:	0
ICPGTO:	=16 ↔ 0
ICPSTO:	=15 ↔ 0
;IDCON IDCONZ IDCONI IDCNFI IDCNFO IDCNFX IDCNQ1 IDCNQ2 IDCONW IDCONC IDCONX IDCONY IDCONS IDCONB IDCONP IDCOND IDCONF IDSOCS IDSOCK IDSOC0 IDSOC1 IDSOC2

repeat 0,<

;	IDCON:	INITIIZE DATA LINK CONNECTION ROUTINE

;	THIS ROUTINE WILL INITIALIZE A DATA CONNECTION TO THE USER.
;		CALL:	MOVEI B,0	;FOR DATA OUT CONNECTION
;			MOVEI B,1	;FOR DATA IN
;			PUSHJ P,IDCON
;			ERROR RETURN
;			SUCCESS RETURN

IDCON:
   IFN VERBOSE, <
	OUTSTR	[ASCIZ /Initializing data link /]
	JUMPN	B,.+2
	OUTSTR	[ASCIZ /out/]
	JUMPE	B,.+2
	OUTSTR	[ASCIZ /in/]	>
	PUSHJ	P,IDSOCK	;TELL USER WHICH DATA SOCKET WE'RE USING
	MOVE	A,DOTYPE(B)
	MOVE	A,IMODES(A)
	HRRM	A,IDCONI
	MOVE	A,IDCONB(B)
	MOVEM	A,IDCONI+2
	DPB	B,[POINT 4,IDCONI,12]
	DPB	B,[POINT 4,IDCNFI,12]
	DPB	B,[POINT 4,IDCNFO,12]
	DPB	B,[POINT 4,IDCONC,12]
	DPB	B,[POINT 4,IDCNQ1,12]
	DPB	B,[POINT 4,IDCNQ2,12]
	DPB	B,[POINT 4,IDCONW,12]
IDCONZ:	DPB	B,[POINT 4,IDCONY,12]
IDCONI:	INIT	000,000
	SIXBIT	/IMP/
	XWD	DOBUF,DIBUF
	JRST	NOIMP
	JUMPE B,IDCNFO
IDCNFI:	INBUF 000,0
	JRST IDCNQ1
IDCNFO:	OUTBUF 000,0
IDCNQ1:	MTAPE	000,ICPGTO	;GET SYSTEM DEFAULT TIMEOUTS
	MOVE	A,ICPGTO+1	;GET SYSTEM DEFAULT TIMEOUTS IN A
	OR	A,[17,,400000]	;RFC TIMEOUT≥64 SECONDS, ALLOC TIMEOUT ≥30 SEC
	MOVEM	A,ICPSTO+1
IDCNQ2:	MTAPE	000,ICPSTO	;SET TIMEOUTS
	CAIN	B,1		;ARE WE RECEIVING DATA?
IDCONW:	MTAPE	000,[=13↔1]	;  YES, GIVE ALLOCATION
	SETZM	CONECB
	MOVE	A,LDSS(B)
	MOVEM	A,CONECB+LSLOC
	MOVE	A,FDRS(B)
	MOVEM	A,CONECB+FSLOC
IFE FTIP,<
	MOVE	A,HOSTNO
	MOVEM	A,CONECB+HNLOC
>;IFE FTIP
IFN FTIP,<
	MOVE	0,HOSTNO
	PUSHJ	P,H2TOIP		;Get IP address
	 JFCL				;Lose!
	MOVEM	0,CONECB+HNLOC
>;IFN FTIP
	MOVE	A,DOBS(B)
	MOVEM	A,CONECB+BSLOC
	SETZM	CONECB+WFLOC		;DON'T WAIT FOR CONNECTION
IDCONC:	MTAPE	000,CONECB		;INITIATE DATA CONNECTION W/ USER
IDCONX:	INTOFF		;ARRIVE HERE IF WE MUST WAIT FOR CONNECTION
IDCONY:	MTAPE	000,IDCONS		;GET STATUS OF DIMP
	INTON
	MOVE	A,IDCONS+1(B)
	TRNE	A,77			;ANY ERROR CODES?
	POPJ	P,			;  YES
	TLNE	A,CLS			;ANYBODY CLOSING CONNECTION?
	POPJ	P,			; YES
	TLC	A,RFC
	TLCN	A,RFC			;CONNECTION COMPLETE?
	JRST	IDCONF			;  YES, SUCCESS RETURN
ifn verbose,<
	tlne	a,200000	;rfcs?
	outchr	["S"]
	tlne	a,100000	;rfcr?
	outchr	["R"]
>;verbose
	PUSHJ	P,@IDCOND(B)
	XCT	IDCONZ		;THIS INSTRUCTION MAKES IDCON REENTRANT
				; - OR ENOUGH SO TO WORK, ANYWAY!
	JRST	IDCONX
IDCONS:	2 ↔ 0 ↔ 0
IDCONB:	XWD	DOBUF,0
	XWD	0,DIBUF
IDCONP:	POINT	6,DOBUF+1,11
	POINT	6,DIBUF+1,11
IDCOND:	DOWAIT
	DIWAIT
IDCONF:	MES	(...done)
	MOVE	A,DOBS(B)	;GET CONNECTION BYTE SIZE
	DPB	A,IDCONP(B)	;SET BYTE SIZE IN BUFFER HEADER
	JRST	CPOPJ1

IDSOCS:	ASCIZ /255 SOCK 0000000000XX/
IDSOCK:	PUSHJ	P,IDSOC0	;PUT SOCKET NUMBER INTO ABOVE STRING
	MOVEI	D,15		;PUT CRLF INTO ABOVE STRING
	IDPB	D,C
	MOVEI	D,12
	IDPB	D,C
	SETZ	D,
	IDPB	D,C
	MOVE	E,[POINT 7,IDSOCS]
	MOVEI	A,DOMP
	ADD	A,B		;C(A) = DIMP or DOMP
	PUSHJ	P,GSR		;GET PERMISSION TO OUTPUT ON CONTROL LINK
	PUSHJ	P,ASCIIE
	SOS	IMPSTF
	POPJ	P,
IDSOC0:	MOVE	C,[POINT 7,IDSOCS+1,27]	;POINTS TO " " AFTER "SOCK" IN IDSOCS
	MOVE	D,LDSS(B)	;GET DATA SOCKET NUMBER
IDSOC1:	IDIVI	D,12
	PUSH	P,E		;PUSH LOW ORDER DIGIT ONTO STACK
	SKIPE	D		;WAS IT HIGH ORDER DIGIT ALSO?
	PUSHJ	P,IDSOC1	;  NO, GET ANOTHER DIGIT
IDSOC2:	POP	P,D		;GET DIGIT
	ADDI	D,"0"		;CONVERT TO ASCIZ
	IDPB	D,C		;STUFF INTO STRING
	POPJ	P,		;GET NEXT DIGIT OR RETURN IF NONE
>;repeat 0
;ILDDEV ILDSTT DPBIT ILDDO NOOPEN ILDVCH ILDVC1 ILDVC2 NOUFDC ACCOK ILDL69 ILDDL1 ILDDL ILDDE0 ILDDET ILDE69 ILDDE1 ILDDE ILDDUG ILDDD ILDDRN ASSHOL ILD123 ILDD ILDSS1 ILDSS2 ACCCHK OWNACC GRPCHK

;;	ILDDEV - INITIALIZE LOCAL DATA DEVICE
;;THIS ROUTINE DOES THE NECESSARY OPEN'S, LOOKUP'S OR ENTER'S REQUIRED
;;SO THAT INPUT OR OUTPUT UUO'S ON THE CHANNELS FIMP, FOMP WILL FUNCTION.
;;NOTE: THE LOCAL DATA DEVICE NEED NOT NECCESSARILY BE THE DISK.
;;	CALL:	MOVE	C,[<DEVICE NAME IN SIXBIT>]
;;		MOVE	D,[<PPN IN SIXBIT>]
;;		MOVE	E,[<XWD <FILE EXTENSION IN SIXBIT>,0]
;;		MOVE	F,[<FILE NAME IN SIXBIT>]
;;		MOVEI	B,1	(FOR DATA OUT TO  IMP, LOCAL LOOKUP)
;;			 ,5	(FOR STAT, LOCAL LOOKUP, NO DATA TRANSFER)
;;			 ,2∨6	(FOR DATA IN FROM IMP, LOCAL ENTER)
;;				(6 FOR MAIL OR MLFL, COPIES OLD FILE LATER)
;;			 ,3	(FOR DATA IN FROM IMP, LOCAL UPDATE)
;;			 ,10	(FOR RNTO OR DELE)
;;			 ,21	(FOR RNFR, DOES LOOKUP BUT CHECKS WRITE ACCESS)
;;		PUSHJ	P,ILDDEV
;;		ERROR	RETURN
;;		SUCCESS	RETURN

ILDDEV:	SETZM	UFDOKF#		;FLAG WHERE -1 MEANS DON'T CHECK UFD PROTECTION
	CAIN	B,6		;HERE FROM MAIL OR MLFL?
	SETOM	UFDOKF		;YES
	TRNN	D,-1		;WAS A PROGRAMMER NAME SPECIFIED?
	MOVE	D,ALIPPN	;  NO, USE THE DEFAULT PPN
	CAIN B,10
	JRST ILDSTT		;DON'T CHANGE STORED FILENAME FOR RNTO OR DELE
	MOVEM C,ERRDEV#
	MOVEM F,ERRFIL#
	HLLZM E,ERREXT#
	MOVEM D,ERRPPN#
ILDSTT:	TRZ	B,4
	TLZ FLG,(MEOFBT)		;STAYS 0 EXCEPT FOR MAIL
IFN VERBOSE, <
	OUTSTR	[ASCIZ /Opening local file system... /]
>
	SETZM ERRTYP#			;THIS WILL INDICATE WHEN ERROR HAPPENS
	MOVEM	C,ILDD+1	;store device name for OPEN
	MOVE	A,DOTYPE
	TRNE	B,2
	MOVE	A,DITYPE
	MOVE	A,FMODES(A)
	MOVE T,C		;get device name
	DEVCHR T,
	TLNE T,200000		;SKIP IF NOT DISK
	 TRO A,200		;***** ONLY IF DEVICE IS DISK!!
	MOVEM	A,ILDD
	MOVEI	A,2			;ASSUME RENAME, USE INPUT CHANNEL
	TRNE	B,10			;FORGET OPEN STUFF IF RENAMING
	JRST	DPBIT
	MOVE T,B
	ANDI T,3
	MOVE	A,[FOBUF
		   FIBUF,,0
		   FIBUF,,FOBUF]-1(T)	;BUFFER STRUCTURE
	MOVEM	A,ILDD+2
	MOVE	A,[2↔3↔3]-1(T)			;CHANNELS
DPBIT:	DPB	A,[POINT 4,ILDDO,12]		;DEPOSIT CHANNEL NUMBERS EVERYWHERE.
	DPB	A,[POINT 4,ILDDL,12]
	DPB	A,[POINT 4,ILDDE,12]
	DPB	A,[POINT 4,ILDDE1,12]
	DPB	A,[POINT 4,ILDDL1,12]
	DPB	A,[POINT 4,ILDDUG,12]
	DPB	A,[POINT 4,ILDL69,12]
	DPB	A,[POINT 4,ILDE69,12]
	DPB	A,[POINT 4,ILDDRN,12]
	DPB	A,[POINT 4,ASSHOL,12]	;YA MISSED ONE!!!
	DPB	A,[POINT 4,ILDVC1,12]
	DPB	A,[POINT 4,ILDVC2,12]
	HRRM A,ILDVCH
	TRNE	B,10			;NO OPEN ON RNTO
	 JRST	 NOOPEN			;  BECAUSE RNFR DID IT
ILDDO:	OPEN	000,ILDD
	POPJ	P,		;ERROR RETURN, CAN'T OPEN DEVICE
NOOPEN:
	AOS ERRTYP
IFN VERBOSE, <OUTSTR	[ASCIZ / OPEN/]>
ILDVCH:	MOVEI T,000		;CHANNEL NUMBER
	DEVCHR T,
	TLNN T,200000		;SKIP IF DISK
	JRST [AOS ERRTYP↔JRST ACCOK]
ILDVC1:	GETSTS 000,T
	TRO T,200
ILDVC2:	SETSTS 000,(T)
	MOVEI T,217
	MOVEM T,ILDD
	SETZM ILDD+2
	OPEN UFDC,ILDD		;CHANNEL FOR UFD LOOKUPS TO CHECK FILE ACCESS
	 JRST [MES(Access check OPEN failure)↔POPJ P,]
	MOVEM D,ILDD		;PREPARE TO LOOKUP UFD
	CAMN D,['  1  1']	;DON'T ACCESS CHECK MFD IF READING UFD
	JRST NOUFDC
	HRLZI T,'UFD'
	MOVEM T,ILDD+1
	SETZM ILDD+2
	MOVE T,['  1  1']
	MOVEM T,ILDD+3
	LOOKUP UFDC,ILDD
	 JRST [MES(No UFD for access check)↔POPJ P,]
	PUSHJ P,GRPCHK
	SKIPE UFDOKF		;DO WE NEED TO CHECK THE UFD PROTECTION?
	JRST NOUFDC		;NO
	PUSHJ P,ACCCHK		;CHECK ACCESS
	 JRST [MES(UFD access prohibited)↔POPJ P,]
NOUFDC:	MOVEM	D,ILDD+3	;Store PPN in lookup block
	MOVEM	F,ILDD		;store filename
	MOVEM	E,ILDD+1	;store extension
	SETZM	ILDD+2
	LOOKUP UFDC,ILDD	;NOW WE CHECK THE ACTUAL FILE
	 JRST [AOS ERRTYP↔JRST ACCOK]
	CAMN D,['  1  1']	;IF READING A UFD,
	PUSHJ P,GRPCHK		; NOW IS THE TIME FOR GROUP CHECKING
	PUSHJ P,ACCCHK		;CHECK FILE ACCESS
	 JRST [MES(File access prohibited)↔POPJ P,]
	RELEAS UFDC,		;DONE READING FILE FOR ACCESS CHECK
ACCOK:	AOS ERRTYP
	MOVEM	D,ILDD+3	;store PPN in lookup block
	MOVEM	F,ILDD		;store filename
	MOVEM	E,ILDD+1	;store extension
	SETZM	ILDD+2
	TRNN	B,1		;going to do input?
	JRST	ILDDET		;no
	PUSH P,JOBFF		;RECYCLE BUFFER SPACE
	MOVEI T,DSKIBF		;FIXED LOCATION
	MOVEM T,JOBFF
	MOVE T,C		;get device name
	DEVCHR T,
	TLNE T,200000		;skip if device isn't a disk
	JRST ILDDL1		;use more buffers for disk
ILDL69:	INBUF 000,0		;use standard number of buffers for other devices
	CAIA
ILDDL1:	INBUF 000,NBUFS		;use optimal number of buffers for disk
	POP P,JOBFF		;JUST IN CASE SOMEBODY ELSE USES IT
ILDDL:	LOOKUP	000,ILDD
	 JRST	 [CAIN	B,3	 ;IF UPDATING, LOOKUP FAILURE IS OK
		  JRST ILDDE0
		  MES(LOOKUP failed)
		  POPJ P,	 ; OTHERWISE, IT ISN'T
]
ILDDE0:
;;	SETZM FOBTSL		;SET UP FOR IMAGE INPUT
repeat 0,<
	MOVEI T,1
	LSH T,@DOBS
	SUBI T,1
	MOVEM T,FOMASK
>;repeat 0
ILDDET:	TRNN	B,2
	 JRST	 ILDDD		;INPUT ONLY
	PUSH P,JOBFF
	MOVEI T,DSKOBF
	MOVEM T,JOBFF
	MOVE T,C		;get device name
	DEVCHR T,
	TLNE T,200000		;skip if device isn't a disk
	 JRST ILDDE1		;use more buffers for disk
ILDE69:	OUTBUF 000,0		;use standard number of buffers for other devices
	CAIA
ILDDE1:	OUTBUF 000,NBUFS	;use optimal number of buffers for disk
	POP P,JOBFF
	MOVEM D,ILDD+3		;REPLACE ZAPPED PPN
	HLLZS ILDD+1		;DATE75
	SETZM ILDD+2
repeat 0,<
	MOVE T,[ILDD,,OMLNAM]	;SAVE FILE FOR LATER LOOKUP IN CASE IT'S MAIL
	BLT T,OMLNAM+3
>;repeat 0
ILDDE:	ENTER 000,ILDD
	JRST [MES(ENTER failed)↔POPJ P,]
repeat 0,<
	MOVEI T,=36
	MOVEM T,FIBTSL
	SETZM FIWORD
	MOVS T,DIBS
	LSH T,6
	IOR T,[POINT 0,FIWORD]
	MOVEM T,FIBPT
>;repeat 0
	CAIN	B,3		;UPDATE FILE?
ILDDUG:	UGETF	000,A		;DOES USETO TO NEXT FREE
ILDDD:	MOVE T,DOTYPE
	TRNE B,2
	MOVE T,DITYPE
	XCT ILDSS1(T)
	TRNE B,1
	DPB T,[POINT 6,FOBUF+1,11]
	TRNE B,2
	DPB T,[POINT 6,FIBUF+1,11]
	TRNN	B,10		;RENAME TIME
	 JRST	 ILD123
ILDDRN:	HLLZS ILDD+1
	SETZM ILDD+2
ASSHOL:	RENAME	000,ILDD	;DO IT
	JRST [MES(RENAME failed)↔POPJ P,]
ILD123:	MES	( Done)
	JRST	CPOPJ1

ILDD:	BLOCK	4

ILDSS1:	MOVEI T,7		;TABLE OF BYTE SIZE GOBBLERS BY XFER TYPE
	MOVEI T,=36
	PUSHJ P,ILDSS2		;LOCAL, NEED DOBS OR DIBS

ILDSS2:	MOVE T,DOBS
	TRNE B,2
	MOVE T,DIBS
	POPJ P,

ACCCHK:	MOVE T,ILDD+2		;GET PROTECTION
	TLZ T,600000		;FLUSH THESE LOSING BITS
	SKIPN OWNER		;IF USER HAS GROUP ACCESS PRIVS TO THIS UFD,
	CAMN D,UPPN		; OR IF FILE PPN IS USER'S PPN,
	JRST OWNACC		; USE OWNER ACCESS
	LSH T,3			;ELSE EITHER LOCAL OR GUEST ACCESS
	TLNN FLG,(PASSBT)	; DEPENDING
	LSH T,3
OWNACC:	TRNE B,36		;IF ANYTHING OTHER THAN STRAIGHT READ,
	LSH T,1			;  CHECK WRITE ACCESS
	TLNN T,200000		;THE MAGIC BIT SHOULD ALWAYS BE HERE NOW
	AOS (P)			;ACCESS OK
	POPJ P,

GRPCHK:	SETZM OWNER#		;THIS WILL FLAG OWNER ACCESS
	AOS ERRTYP		;WE'VE FOUND THE UFD
	MTAPE UFDC,PRVMTA	;READ RETRIEVAL
	 POPJ P,		;CAN'T, NO GROUP ACCESS
	SETZM PASWD		;JUST IN CASE WE HAVE INF
	MOVE T,GRPWD		;GET FILE ACCESS GROUPS FOR THIS UFD
	AND T,[GROUPS]		;JUST THE RIGHT BITS PLEASE
	HRRZ A,ILDD		;PRG OF TARGET UFD
	CAME A,UPRG		;PRG OF OUR USER
	TRZ T,MASPRV		;NOT THE SAME, NO MAS ACCESS
	TLO T,REAPRV!WRTPRV	;ALSO ALLOW REA AND WRT ACCESS
	TDNE T,PRIVS		;DOES USER HAVE ANY CORRESPONDING PRIVS?
	SETOM OWNER		;YES! ALLOW OWNER ACCESS
	POPJ P,
;⊗ START %SITE% REGO

;	MAIN PROGRAM STARTS HERE

START:	JFCL
	RESET
	SETZM HSTADR		;no host table mapped in now, since JOBFF reset
	OUTSTR [ASCIZ/SMTPSR started
/]
	MOVE [SIXBIT/SMTPSR/]
	SETNAM
	MOVE P,[XWD -PDLL,PDL]		;GET A PUSH DOWN LIST
	CLKINT =30*=60*=60
	SETZM PRIVS			;PARANOID?  ME, PARANOID?
	SETZ FLG,			;Zero flags
IFN FTREQL,<
	SETZM USEROK		;nonzero indicates login done (can't be flag in FLG)
>;IFN FTREQL
	SETO B,
	GETLIN B
	MOVEM B,TTYNUM#
	SETZM OURH3		;clear all our host numbers
	MOVE T1,[OURH3,,OURH3+1] ;BLT source,,dest
	BLT T1,OURH3+LOURH3-1	;clear entire array
	MOVSI T1,377777
	SETPR2 T1,		;peek at system
	 JRST [	OUTSTR [ASCIZ/?? SETPR2 failed./]
		EXIT 1,
		JRST %SITE% ]	;let him continue, we just don't know who we are
	SKIPL T1,400000!355	;lowcore 355 is aobjn ptr to our HOSTS3 address
	JRST [			;can't tell who we are if no addresses
		OUTSTR [ASCIZ /?? No valid host number for us pointed to by exec 355./]
		EXIT 1,
		JRST %SITE% ]	;let him continue, we just don't know who we are
	HLRE T2,T1		;- number of addresses
	MOVN T2,T2		;make positive nbr of host numbers
	CAILE T2,LOURH3		;skip if our table is as at least big as systems
	MOVEI T2,LOURH3		;only store as many as we have room for
	MOVSI T3,400000(T1)	;BLT source address -- in system
	HRRI T3,OURH3		;BLT dest -- our table of our host number(s)
	BLT T3,OURH3-1(T2)	;copy whole table from system (or what fits)
%SITE%:
	MOVEI B,WATSIT
	PEEK B,			;get WAITS site number from system (CPU,,SITE)
	MOVEI B,(B)		;just site number
	CAIL B,MAXSIT		;reasonable site number?
	MOVEI B,MAXSIT-1	;no, use unknown site
	MOVEM B,WAITST		;remember it for figuring out our host name
	INIT	IMP,1
	 ('IMP')
	 OBUF,,IBUF
	 JRST NOIMP
IFE FTIP,<
	INIT 17 			; open IMP in dump mode
	 ('IMP')
	 0				; no buffers
	 JRST NOIMP
	MTAPE [17 ↔ BYTE (6)1,=10,0,=30,0,0]; set timeouts
	MTAPE ICPBLK			; connect → foreign logger
	MOVE B,ICPSTS			; check for MTAPE error
	TRNE B,77
	 JRST QUIT
	STATZ ERRBTS
	 JRST QUIT
	TLC B,RFC			; for next instruction to win
	TLCE B,RFC			; legal socket state?
	 JRST QUIT
	MOVEI A,21
	MTAPE A
	MOVEM B,LCRS
	DPB B,[044000,,ICPS#]
	HRROI B,ICPS-1
	SETZ C,
	OUT B				; send socket from user
	 CAIA				; won
	  JRST QUIT
	RELEAS
	OUTSTR	[ASCIZ /Using socket /]
	MOVSI	B,-14
	MOVE	D,LCRS
	SETZ	C,
	LSHC	C,3
	ADDI	C,"0"
	OUTCHR	C
	AOBJN	B,.-4
	OUTSTR	[ASCIZ /, connecting to host /]
	PUSHJ P,GETHNM
	OUTSTR HSTSTR
	OUTSTR [ASCIZ/
/]
	MOVE	A,LCRS
	ADDI	A,1
	MOVEM	A,LCSS
	ADDI	A,1
	MOVEM	A,LDRS
	ADDI	A,1
	MOVEM	A,LDSS
	MOVE	A,ICPSKT
	ADDI	A,2
	MOVEM	A,FCRS
	ADDI	A,1
	MOVEM	A,FCSS
	ADDI	A,1
	MOVEM	A,FDRS
	ADDI	A,1
	MOVEM	A,FDSS
>;IFE FTIP
IFN FTIP,<
	MOVEI A,FTPSKT		;listen port
	MOVEM A,LCRS		; is used for both send
	MOVEM A,LCSS		; and receive of control connection
	SUBI A,1		;port one less
	MOVEM A,LDRS		; is used for both send
	MOVEM A,LDSS		; and receive of data connection
>;IFN FTIP
	MOVEI	A,ILEVEL	;INTENB USED TO BE AFTER ICP
	MOVEM	A,JOBAPR	;  SO A VERY QUICK CLOSE COULD GO UNNOTICED
	MOVSI	A,INTINP!INTIMS!INTINS
	INTENB	A,		;ENABLE FOR IMP INPUT INTERRUPTS
	PUSHJ	P,ICP	;INITIAL CONNECTION PROTOCOL
	JRST	ERRKIL
	INBUF	IMP,2
	OUTBUF	IMP,2
	MOVEI	A,=8
	DPB	A,[POINT 6,IBUF+1,11]
	DPB	A,[POINT 6,OBUF+1,11]
;dcs: 4-12-73
;Some sites won't send allocation for our control out link until we
; send them some for our control in link.  We don't do that (in the NCP)
; until the user program does something to suggest input -- so that
; user-specified allocation, if any, will be used.  This test for input
; is sufficient to get our NCP to send allocation.
	mtape	imp,[=8]	;send them allocation for control conn.
	jfcl
	PUSHJ	P,GREET		;SEND USER OUR GREETING MESSAGE
	MOVEM P,SAVPDP#
IFN FTIP,<
	PUSHJ P,SAYWHO		;type out name of host we're talking to
>;IFN FTIP
REGO:	MOVE P,SAVPDP
	MOVE A,CIP1
	MOVEM A,CIP
;	MOVE A,DIP1
;	MOVEM A,DIP
;	MOVE A,DOP1
;	MOVEM A,DOP			;BECOMES CLEAR NEED TO 
	SETZM	CIHUNG			; SAVE DATA IN COMMON
;	SETZM	DIHUNG			; AND CLEAR WITH BLT'S!
;	SETZM	DOHUNG
	SETZM	QUITNG
	SETZM	DIACTV
	SETZM	DOACTV
	SETZM PRIVS			;PARANOID?  ME, PARANOID?
;LOOP SCHEK STATUS

;;	MAIN LOOP	OF FTPS
;;		PROGRAM LOOPS UNTIL XACTV IS INCREASED TO ZERO, THEN GOES
;;	INTO INTERRUPT WAIT.  INTERRUPT-LEVEL MODULE WILL SET XACTV TO
;;	A SMALL NEGATIVE INTEGER, AND MAY ALSO SET SCHEKF

LOOP:	CLKINT =30*=60*=60
	AOSG	SCHEKF		;TIME TO CHECK IMP STATUS?
	PUSHJ	P,SCHEK		;  YES
	PUSHJ	P,CIDISP	;DISPatch to Control Input handler
;	SKIPE	DIACTV		;Data In channel ACTiVe?
;	PUSHJ	P,DIDISP	;  YES
;	SKIPE	DOACTV
;	PUSHJ	P,DODISP
	INTMSK	[0]
	AOSLE	XACTV		;ANYTHING STILL WANTING ATTENTION?
	IMSTW	[-1]		;  NO, ENABLE INTERRUPTS AND WAIT
	INTMSK	[-1]		;ENABLE INTERRUPTS IN CASE WE SKIPPED
	JRST	LOOP

SCHEK:	MTAPE	IMP,STATUS
	MOVE	A,STATUS+1
	OR	A,STATUS+2
	TLC A,RFC		;these bits should be on (now off)
	TLNN A,RFC!CLS		;CONTROL LINK CLOSING?
	POPJ	P,		;  NO, ALL IS OK
IFN VERBOSE,<
	OUTSTR	[ASCIZ / Control link closed!/]
>;
	JRST	ERRKIL

STATUS:	2 ↔ 0 ↔ 0
;SAVACX SAVACS GETACS

;;	ACCUMULATOR SAVE, RESTORE ROUTINES,   ALSO CLOCK TURNING-ON ROUTINE

SAVACX:	0
SAVACS:			;CALL:	PUSH P,[XWD 0,<ADDRESS OF 17 WORD BLOCK>]
			;	JRST SAVACS
			;	ROUTINE DOES NOT RETURN.  THE ARGUMENT
			;  ON THE STACK IS POPPED OFF, AND THEN A POPJ
			;  IS PERFORMED.
	MOVEM	0,@(P)		;SAVE AC0
	MOVE	0,(P)
	ADD	0,[XWD 1,16]	;C(0) = 1,,LOC+16
	HRRZM	0,SAVACX
	SUBI	0,15		;C(0) = 1,,LOC+1
	BLT	0,@SAVACX	;SAVE AC1-16
	SUB	P,[XWD 1,1]	;DELETE ARGUMENT FROM STACK
	POPJ	P,		;RETURN UPLEVEL

GETACS:			;CALL:	PUSHJ P,GETACS
			;	XWD 1,<ADDRESS OF 17 WORD BLOCK>
			;	RETURN HERE ALWAYS
	HRLZ	16,@(P)		;C(16) = XWD <ADDR>,0
	BLT	16,15		;RESTORE ACS 0-15
	HRRZ	16,@(P)
	MOVE	16,16(16)	;RESTORE AC16
	JRST	CPOPJ1		;RETURN
;CIDISP CIREEN CIWAIT CIWAIX CIACS CIP CIP1 CIHUNG CIPDL DIDISP DIREEN DIWAIT DIACS DIP DIP1 DIHUNG DIPDL DODISP DOREEN DOWAIT DOACS DOP DOP1 DOHUNG DOPDL

;	DISPATCH ROUTINES

;	CI PREFIX MEANS CONTROL INPUT
;	DI PREFIX MEANS DATA INPUT
;	DO PREFIX MEANS DATA OUTPUT

CIDISP:	SKIPE	CIHUNG		;IS CI ROUTINE HUNG? (I.E., IS IT IN THE
				;  MIDDLE OF SOMETHING AND WAITING?)
	JRST	CIREEN		;    YES, REENTER CI ROUTINE
	EXCH	P,CIP
	PUSHJ	P,CIROUT	;    NO, START AT BEGINNING OF CI ROUTINE
	EXCH	P,CIP		;SAVE CI PDL, GET OLD PDL
	SETZM	CIHUNG		;INDICATE THAT CI ROUTINE FINISHED NORMALLY
	POPJ	P,		;RETURN TO MAIN LOOP
CIREEN:	PUSHJ	P,GETACS
	XWD	1,CIACS
	EXCH	P,CIP		;RETRIEVE CI PUSHDOWN POINTER
	POPJ	P,		;AND RETURN WO WAITING CI ROUTINE.
CIWAIT:	SETOM	CIHUNG		;PUSHJ TO HERE TO MAKE CI ROUTINE WAIT
CIWAIX:	EXCH	P,CIP		;SAVE CI PDL, GET OLD PDL
	PUSH	P,[XWD 0,CIACS]
	JRST	SAVACS		;SAVE CI ACCUMULATORS, RETURN TO MAIN LOOP


CIACS:	BLOCK	17		;STORAGE FOR CI ACCUMULATORS 0-16
CIP:	XWD -PDLL,CIPDL		;STORAGE FOR CI ACCUMULATOR 20 WHEN CI
CIP1:	XWD -PDLL,CIPDL
				;  ROUTINE IS ACTIVE, MAIN ACC 17 OTHERWISE
CIHUNG:	0			;NON ZERO MEANS CI ROUTINE IS WAITING
CIPDL:	BLOCK PDLL

repeat 0,<
DIDISP:	SKIPE	DIHUNG
	JRST	DIREEN
	EXCH	P,DIP
	PUSHJ	P,DIROUT
	EXCH	P,DIP
	SETZM	DIHUNG
	POPJ	P,
DIREEN:	PUSHJ	P,GETACS
	XWD	1,DIACS
	EXCH	P,DIP
	POPJ	P,
DIWAIT:	SETOM	DIHUNG
	EXCH	P,DIP
	PUSH	P,[XWD 0,DIACS]
	JRST	SAVACS
DIACS:	BLOCK	17
DIP:	XWD	-PDLL,DIPDL
DIP1:	XWD	-PDLL,DIPDL
DIHUNG:	0
DIPDL:	BLOCK	PDLL

DODISP:	SKIPE	DOHUNG
	JRST	DOREEN
	EXCH	P,DOP
	PUSHJ	P,DOROUT
	EXCH	P,DOP
	SETZM	DOHUNG
	POPJ	P,
DOREEN:	PUSHJ	P,GETACS
	XWD	1,DOACS
	EXCH	P,DOP
	POPJ	P,
DOWAIT:	SETOM	DOHUNG
	EXCH	P,DOP
	PUSH	P,[XWD 0,DOACS]
	JRST	SAVACS
DOACS:	BLOCK	17
DOP:	XWD	-PDLL,DOPDL
DOP1:	XWD	-PDLL,DOPDL
DOHUNG:	0
DOPDL:	BLOCK	PDLL
>;repeat 0
;CIROUT COMDIS BADCOM

;;	CI ROUTINE  - READ COMMANDS FROM CONTROL LINK, SEND ANSWERS, ETC.

CIROUT:	PUSHJ	P,GETCOM	;READ COMMAND FROM IMP
	POPJ	P,		;  IT WAS A BUM COMMAND
	PUSHJ	P,GETIDX	;C(A) ← # OF COMMAND
	PUSHJ	P,@COMDIS(A)
	JRST	SXACTV		;4-28-73 make sure all input is read.

DEFINE X(A,B) <IFIDN<B><><0+A;>0+B>; second arg is address if different from name
COMDIS:	BADCOM
	NAMES

BADCOM:	PUSHJ P,FLUSCS
	PUSHJ	P,GSRCI		;GET PERMISSION TO OUTPUT ON CONTROL CHANNEL
	PUSHJ	P,IMPST0
	ASCIZ	/500 No comprendo "/
	PUSHJ	P,ASCII1
	C
	PUSHJ	P,IMPST0
	ASCIZ	/"
/
	SOS	IMPSTF		;RETURN PERMISSION
	JRST	FLUSCS
;APPE STOR WAITIL GETSET GETSE1 GETSEL C2 GETSEA MLFL STORX3 STORX0 STOR1 RETRX1 STORX1 ILDERR ILDER1 STOMES ERRNUM ERRNM1 TYPNAM ERRTXT ERRTX1 TYPDSP ERRPP ERRPP1 ERRPP2 ERRMF ERRMF1 ERRFN ERRFN1

;;	APPEND, STOR, MLFL -- RECEIVE A FILE. GETSET, ILDERR, STOMES, WAITIL

repeat 0,<
APPE:	SKIPA	B,[3]		;APPEND
STOR:	MOVEI	B,2		;STORE
	PUSHJ P,WAITIL		;WAIT FOR OLD FILENAME, XFERTYPE FREE
	MOVEM	B,STORTYP#	;SAVE FOR MESSAGE LATER
IFN FTREQL,<
	SKIPN USEROK		;logged in?
	JRST MUSTLG		;nope, lose
>;IFN FTREQL
	SKIPE	DIACTV		;DATA CHANNEL ALREADY IN USE?
	JRST	STORX0		;  YES
	MOVEI B,1
	PUSHJ P,GETSET		;SET UP DITYPE, DIBS
	 JRST ASCERR
	PUSHJ	P,GFN		;GET FILE NAME
	JRST	STORX1		;  DIDN'T GET ONE
	SETZM EOFMAI
	SETOM HOLDIL		;DON'T LET ANYONE ELSE IN
	MOVE	B,STORTYP
	PUSHJ	P,ILDDEV	;INITIALIZE LOCAL DATA DEVICE
	JRST	ILDERR		;  FAILED
	MOVEM	C,DIACS+C	;PASS ON FILE NAME INFORMATION,
	MOVEM	D,DIACS+D	;  ETC. TO THE
	MOVEM	E,DIACS+E	;  DI ROUTINE
	MOVEM	F,DIACS+F
	SETOM	DIACTV		;STARTUP DI ROUTINE
	JRST	FLUSCS		;FLUSH COMMAND STRING & RETURN

WAITIL:	SKIPN HOLDIL#		;WAIT FOR HOLDIL FREE
	POPJ P,			;  WHICH MEANS WE DON'T NEED ERRFIL ETC ANYMORE
	PUSHJ P,CIWAIT
	JRST WAITIL
>;repeat 0

;; GETSET	SET UP TYPE AND BYTE SIZE FOR TRANSFER
;;CALL:	MOVEI B,<0 FOR DO, 1 FOR DI>
;;	PUSHJ P,GETSET
;;	 ERROR RETURN - TYPE A AND NOT BYTE 8

;; GETSEA FAKE TYPE A BYTE 8 FOR MAIL/MLFL, NO SKIP RETURN

GETSET:	MOVE A,RTYPE		;GET TYPE FROM USER
	CAIN A,3		;LOCAL PRINT
	MOVEI A,0		;  IS REALLY ASCII
;;;	JUMPE A,GETSEA		;ASCII USES BYTE 8 REGARDLESS
	MOVE T,RBS		;ELSE WE GOBBLE REAL BYTE SIZE
	CAIE T,=8
	JUMPE A,CPOPJ
	AOS (P)
	CAIE A,1		;IMAGE?
	JRST GETSEL		;NO, LOCAL BYTE
	CAIE T,=8		;IMAGE, MAYBE CONVERT TO EASIER LOCAL BYTE
	CAIN T,=32		;  BUT NOT FOR THESE BYTE SIZES
	JRST GETSEL
	SKIPA A,C2		;ANY OTHER BYTE SIZE OK FOR LOCAL TYPE
GETSE1:	MOVEI T,=8		;CONSTANT BYTE SIZE FOR ASCII
GETSEL:	MOVEM T,DOBS(B)		;SAVE BYTE SIZE
	HRRZM A,DOTYPE(B)	;  AND TYPE FOR THIS TRANSFER
C2:	POPJ P,2

GETSEA:	MOVEI A,0		;ASCII TYPE
	JRST GETSE1

repeat 0,<
MLFL:	SKIPE	DIACTV		;DON'T DO IT IF THINGS ARE HAPPENING
	 JRST	 STORX3
	MOVEI A,[ASCIZ ⊗MAIL⊗]
	MOVEM A,NTMLCM
	TRO FLG,.MAIL		;NEEDED TO ALLOW FORWARDING
	SKIPGE XRSQSW		; If hacking XRCP,
	 PUSHJ P,XRSRST		; always reset buffer here.
	PUSHJ P,MLNMST			;GET A MESSAGE FILE NAME
	 JRST [	SKIPN XRSQSW		; Bad name... hacking XRCP?
		 JRST NOUSER		; Nope, really failed.
		JUMPG C,NOUSER		; Also fail if any name was spec'd.
		SKIPL XRSQSW
		SKIPE XRFOBP
		 CAIA
		  JRST NOUSER		; Recip-first and no recips.
		SKIPGE XRSQSW		; Skip if R-first style.
		AOS XRBPTR		; Win, ensure we'll start storing
		JRST MLFL20]		; msg text.

	PUSHJ P,VALID		;LOOK UP LOSER IN MFD
	 JRST NOMAIL		;NO SUCH LOSER
	SETZM XRFOBP			; Reset XRCP recipient list.
MLFL20:	MOVE A,XRFOBP
	MOVEM A,XRFHBP		; Flag XRCP-R mode for header
	SETZM XRFOBP		; In case we die before mailing.
	PUSHJ P,FLUSCS		;PREVENT SPURIOUS 500 ERROR
;;	PUSH P,RTYPE		;MLFL IS ALWAYS TYPE ASCII REGARDLESS
;;	SETZM RTYPE
	MOVEI B,1		;FLAG DI
	PUSHJ P,GETSEA		;SET UP TYPE AND BYTE SIZE
;;	POP P,RTYPE
	PUSHJ P,WAITIL

	MOVEI	B,6		;SPECIAL MAIL STORE TYPE
	MOVEM	B,STORTYP
	SETOM EOFMAI		;FLAG FOR DIEOF
	TRZ FLG,17		;FLAG MLFL FOR DIEOML -- NOT MAIL OR FRIENDS
	TLZ FLG,MFRDUN!MSJDUN	;"FROM" & "SUBJECT" LINES NOT FOUND YET
	TLO FLG,(MEOFBT)	;FLAGS MAIL FOR DIEOF
	SKIPGE XRBPTR
	 JRST MLFL40		; Skip output file stuff if saving msg text.

	PUSHJ P,SETMFL
	PUSHJ	P,ILDDEV	;INITIALIZE LOCAL DATA DEVICE
	JRST	ILDERR		;  FAILED
	TLO FLG,(MEOFBT)	;FLAGS MAIL FOR DIEOF (ILDDEV MUNGS)
	MOVEM	C,DIACS+C	;PASS ON FILE NAME INFORMATION,
	MOVEM	D,DIACS+D	;  ETC. TO THE
	MOVEM	E,DIACS+E	;  DI ROUTINE
	MOVEM	F,DIACS+F
	OUT FIMP,		;LEAVE AN EMPTY RECORD FOR LATER
	MOVEI A,40
	PUSHJ P,WRTCHR		;WRITE SOMETHING INNOCUOUS
	SETZM FIBUF+2		;MAKE SURE WE DO ANOTHER OUT
	PUSHJ P,RCVD		;insert line saying when Received and from where
MLFL40:	SETOM	DIACTV		;STARTUP DI ROUTINE
	POPJ P,

STORX3:
STORX0:	PUSHJ	P,IMPSTR
	ASCIZ	/505 You are already STORing!
/
STOR1:	JRST	FLUSCS		;FLUSH REST OF COMMAND STRING

RETRX1:
STORX1:	PUSHJ	P,IMPSTR
	ASCIZ	/501 Pathname unparsable
/
	JRST	FLUSCS
>;repeat 0

ILDERR:	PUSHJ P,GSRCI		;INTERPRET ILDDEV ERROR FOR LOSER
	MOVE F,ERRTYP		;THIS IS THE TYPE OF ERROR
	CAIGE F,3		;  UNLESS ERROR WAS FROM LOOKUP ETC
	JRST ILDER1		;  IN WHICH CASE WE NEED ERROR CODE
	HRRZ C,ILDD+1		;  FROM LOOKUP (ETC) BLOCK
	SKIPA D,ERRNM1(C)	;THIS IS THE RESPONSE CODE IN THAT CASE
ILDER1:	MOVE D,ERRNUM(F)	;RESPONSE CODE FOR NON-LOOKUP-ETC ERROR
	MOVE E,[POINT 7,D]
	PUSHJ P,ASCIIE		;PUT OUT CODE
	PUSHJ P,STOMES		;PUT OUT TYPE OF OPERATION AND FILE
	HRRZ C,ILDD+1		;RESTORING CLOBBERED AC
	MOVE E,[POINT 7,[ASCIZ / failed, /]]
	PUSHJ P,ASCIIE
	CAIGE F,3		;DISPATCH ON ERROR AGAIN
	SKIPA E,ERRTXT(F)
	MOVE E,ERRTX1(C)
	PUSHJ P,ASCIIE
	MOVE E,[POINT 7,[ASCIZ /
/]]
	PUSHJ P,ASCIIE
	SOS IMPSTF
	JRST FLUSCS

STOMES:	MOVE D,STORTYP#		;FIND OUT WHAT HE WAS DOING
	CAIN D,30
	MOVEI D,4		;FILL A BIG HOLE
	MOVE E,TYPNAM-1(D)	;GET PTR TO OPERATION NAME
	PUSHJ P,ASCIIE
	JRST @TYPDSP-1(D)	;PUT OUT FILE NAME OR WHATEVER

REPEAT 0,<
ERRNUM:	ASCII /453 /		;0 - OPEN FAILED
	ASCII /450 /		;1 - UFD LOOKUP FAILED
	ASCII /451 /		;2 - ACCESS PROHIBITED

ERRNM1:	ASCII /450 /		;0 - NO SUCH FILE
	ASCII /450 /		;1 - NO SUCH PPN (CAN'T HAPPEN)
	ASCII /451 /		;2 - PROTECTION VIOLATION (CAN'T)
	ASCII /453 /		;3 - FILE BUSY
	ASCII /450 /		;4 - ALREADY EXISTS (RENAME)
	ASCII /506 /		;5 - NO FILE OPEN (CAN'T)
	ASCII /506 /		;6 - DIFFERENT FILENAME (R/A, CAN'T)
	ASCII /506 /		;7 - CAN'T
	ASCII /453 /		;10 - BAD RTVL
	ASCII /453 /		;11 - BAD RTVL
	ASCII /453 /		;12 - DISK FULL
>;REPEAT 0

ERRNUM:	ASCII /451 /		;0 - OPEN FAILED
	ASCII /451 /		;1 - UFD LOOKUP FAILED
	ASCII /451 /		;2 - ACCESS PROHIBITED

ERRNM1:	ASCII /451 /		;0 - NO SUCH FILE
	ASCII /451 /		;1 - NO SUCH PPN (CAN'T HAPPEN)
	ASCII /451 /		;2 - PROTECTION VIOLATION (CAN'T)
	ASCII /451 /		;3 - FILE BUSY
	ASCII /451 /		;4 - ALREADY EXISTS (RENAME)
	ASCII /451 /		;5 - NO FILE OPEN (CAN'T)
	ASCII /451 /		;6 - DIFFERENT FILENAME (R/A, CAN'T)
	ASCII /451 /		;7 - CAN'T
	ASCII /451 /		;10 - BAD RTVL
	ASCII /451 /		;11 - BAD RTVL
	ASCII /452 /		;12 - DISK FULL

TYPNAM:	POINT 7,[ASCIZ /Retrieve of /]
	POINT 7,[ASCIZ /Store of /]
	POINT 7,[ASCIZ /Append to /]
	POINT 7,[ASCIZ /Rename of /]	;REALLY STORTYP 30
	POINT 7,[ASCIZ /Directory listing for /]
	POINT 7,[ASCIZ /Mail scratch file open/]
	POINT 7,[ASCIZ /Directory listing for /]
	POINT 7,[ASCIZ /Delete of /]

ERRTXT:	POINT 7,[ASCIZ /can't initialize local device/]
	POINT 7,[ASCIZ /no such file directory/]
	POINT 7,[ASCIZ /protection failure/]

ERRTX1:	POINT 7,[ASCIZ /no such file/]
	POINT 7,[ASCIZ /no such file directory/]
	POINT 7,[ASCIZ /protection failure/]
	POINT 7,[ASCIZ /file busy/]
	POINT 7,[ASCIZ /new filename already exists/]
	POINT 7,[ASCIZ /impossible system error (5)/]
	POINT 7,[ASCIZ /impossible system error (6)/]
	POINT 7,[ASCIZ /impossible system error (7)/]
	POINT 7,[ASCIZ /bad retrieval/]
	POINT 7,[ASCIZ /bad retrieval/]
	POINT 7,[ASCIZ /disk is full/]

TYPDSP:	ERRFN		;RETR, WHOLE FILESPEC
	ERRFN		;STOR
	ERRFN		;APPE
	ERRFN		;RENAME
	ERRPP		;STAT, FN AS PPN
	CPOPJ		;MAIL
	ERRFN		;USED FOR START MSG FOR LIST, NLST
	ERRFN		;DELE

ERRPP:	MOVE D,ERRFIL	;DO FILENAME AS PPN
ERRPP1:	TLNN D,-1	;IF MAIL, MAYBE ONLY PRG
	JRST ERRPP2
	MOVEI A,"["
	PUSHJ P,PUTCH1
	HLLZ B,D
	PUSHJ P,SIXWRT
	MOVEI A,","
	PUSHJ P,PUTCH1
ERRPP2:	HRLZ B,D
	JUMPN B,.+2
	MOVEI B,'*  '	;FOR MAIL
	PUSHJ P,SIXWRT
	TLNN D,-1
	POPJ P,
	MOVEI A,"]"
	JRST PUTCH1

ERRMF:	MOVE B,RMLF
	PUSHJ P,SIXWRT
	SKIPN B,RMLE
	JRST ERRMF1
	MOVEI A,"."
	PUSHJ P,PUTCH1
	PUSHJ P,SIXWRT
ERRMF1:	MOVE D,RMLD
	JRST ERRPP1

ERRFN:	MOVE B,ERRDEV
	PUSHJ P,SIXWRT
	MOVEI A,":"
	PUSHJ P,PUTCH1
	MOVE B,ERRFIL
	PUSHJ P,SIXWRT
	SKIPN B,ERREXT
	JRST ERRFN1
	MOVEI A,"."
	PUSHJ P,PUTCH1
	PUSHJ P,SIXWRT
ERRFN1:	MOVE D,ERRPPN
	JRST ERRPP1
;RNFR DELE GCRNTO RENFIL RNMOK RELDMP RNTO BADTO BDTONM BADDRN ALLO

repeat 0,<

;;	RNFR (RNTO), DELE ROUTINE :  ZAP LOCAL FILES

RNFR:	SKIPA	B,[30]		;RENAME
DELE:	MOVEI	B,10		;DELETE
	PUSHJ P,WAITIL
IFN FTREQL,<
	SKIPN USEROK		;logged in?
	JRST MUSTLG		;nope, lose
>;IFN FTREQL
	MOVEM	B,STORTYP	;SAVE WHICH
	SKIPE	DOACTV
	 JRST	 RETRX0
	PUSHJ	P,GFN		;FIRST OR ONLY FILE
	 JRST	 RETRX1
	MOVEI	B,21		;20 BIT CHECKS WRITE ACCESS EVEN THO READ OP
	PUSHJ	P,ILDDEV	;DO THE LOOKUP
	 JRST	 ILDERR		; COULDN'T FIND
	SETZB	E,F
	MOVE	B,STORTYP	;NOW MUST EITHER DELETE OR RENAME
	TRNN	B,20		;RENAME?
	 JRST	 RENFIL		;NO, DELETE
	PUSHJ	P,FLUSCS	;TERMINATE THAT LINE
	PUSHJ	P,IMPSTR	;REPORT PARTIAL SUCCESS
	ASCIZ	/200 RNFR OK, Please issue RNTO
/
GCRNTO:	PUSHJ	P,GETCOM	;NOW GET THE NEXT
	 JRST	 RELDMP		;BAD COMMAND, COULDN'T BE RNTO
	PUSHJ	P,GETIDX
	TRNE	A,777776	;NEXT COMMAND MUST BE RNTO, WHOSE
	 JRST	 BADTO		; COMMAND INDEX IS 1 (LH JUNK)
	PUSHJ	P,GFN
	 JRST	 BDTONM		;BAD NAME AFTER RNTO
	MOVEI	B,10		;ONE MORE TIME
RENFIL:	PUSHJ	P,ILDDEV	;DELETE (RENAME) THE FILE
	 JRST	 BADDRN		; COULDN'T DO THAT
	JUMPN	F,RNMOK
	PUSHJ	P,IMPSTR	;OK RESPONSE
	ASCIZ	/254 File deleted
/
	JRST	RELDMP
RNMOK:	PUSHJ	P,IMPSTR	;OK RESPONSE
	ASCIZ	/253 File renamed
/
RELDMP:	RELEASE	DIMP,		;CLOSE DOWN
	JRST	FLUSCS

RNTO:
BADTO:	PUSHJ	P,IMPSTR
	ASCIZ	/505 Must have RNTO after RNFR
/
	JRST	RELDMP

BDTONM:	PUSHJ	P,IMPSTR
	ASCIZ	/501 Pathname for rename unparseable
/
	JRST	RELDMP

BADDRN:	RELEAS DIMP,
	JRST ILDERR

ALLO:	PUSHJ P,IMPSTR
	ASCIZ/206 It's ALLOver, don't shed a tear for me
/
	JRST FLUSCS
>;repeat 0
;⊗ HELO HELOLP NOOP NOFROM RCPT RCPTML RCPTCL RCPTX SYNERR NORLAY XSEN XSEM XMAS MAIL MAILCM MAILER GETFRM GETFRL GETFRS GETFNQ GETFRE GETFRX OK250 NODEST DATA NMAIL MAILIN NODOT EOMAIL MAIL91 SETMFL RMDLK RMDAOS RMDFIL WRHDR WHDFRB WSCRLF WHDFRM RCDCR WRTSSP WRTSS1 WRTSTR WRTST1 WRTST2 wrtsix wrlp wrsoj SWRTCH WRTCHR CORERR IERR4 HELP NOMAIL NOUSER SYNER2 SENERR NOPPNM RCVD DAYLIT MAISTR MAIST2 MAIDEC MAI2DG

HELO:	MOVE B,[POINT 7,XRFBUF]	;byte ptr for copying name
	MOVEM B,XRFBBP		;save for GETCHR
	SETZM XRFBZZ		;clear any previous overflow
HELOLP:	PUSHJ P,GETCHR
	CAIE A,12
	JRST HELOLP
	MOVEI A,0
	IDPB A,XRFBBP		;terminate string with null
	SETZM XRFBBP		;stop copying
	MOVE A,[XRFBUF,,SNDNAM]
	BLT A,SNDNAM-1+1+MAXPTH/5 ;copy name to where we want it
	PUSHJ P,IMPSTR
	 ASCIZ/250 /
	PUSHJ P,IMPSTH		;output our host name (SU-AI, S1-A, ...)
	PUSHJ P,IMPSTR
	 ASCIZ/.ARPA/
	PUSHJ P,IMPCR		;output crlf
	POPJ P,

NOOP:	REPMES (250 No-op acknowledged.)

NOFROM:	REPMES (503 You forgot to send a MAIL command first.)

RCPT:	SKIPN GOTFRM
	JRST NOFROM		;no MAIL cmd yet
	MOVE B,[POINT 7,XXBUF]	;byte ptr for copying line
	MOVEM B,XXBBP		;save for GETCHR
	SETZM XXBZZ		;clear any previous overflow
	PUSHJ P,GETDST		;Get a destination name
	 JRST NORLAY		;no relaying implemented (yet)
	 JRST SYNERR		;syntax error
	 JRST NOUSER		;ERROR
	PUSHJ P,VALID		;LOOK UP LOSER IN MFD
	 JRST NOMAIL		;NO SUCH LOSER
	SETZM XXBBP		;quit collecting recipient line
ifn 1,<
	TRNE FLG,.MAIL!.XMAS!.XSEM ;skip if cmd is just SEND
	JRST RCPTML		;not just sending, but possibly mailing
	PUSHJ P,LOGGED		;see if this user is logged in
	 JRST SENERR		;nope
RCPTML:
>;ifn 1
	MOVEI A,","
	AOSE FSTDST		;skip if this is first destination
	PUSHJ P,WRTCHR		; Separate recipients in .FTP file
	MOVE B,[POINT 7,XRFBUF]	; set up BPT to copy valid recipient name
RCPTCL:	ILDB A,B
	JUMPE A,RCPTX
	PUSHJ P,WRTCHR		;write char to .FTP file
	JRST RCPTCL

RCPTX:	REPMES (250 Recipient name accepted.)

SYNERR:	PUSHJ P,IMPSTR
	 ASCIZ/500 Syntax error #/
	MOVE A,SYNCOD		;get error code
	PUSHJ P,IMPOCT		;output octal number from A
	PUSHJ P,IMPSTR
	 ASCIZ/ in recipient specification: "RCPT /
	JRST SYNER2		;go copy recipient line into reply

NORLAY:	SETZM XXBBP		;quit collecting recipient line
	REPMES (550 Mail relaying not yet implemented.)

;;MAIL -- ACCEPT NETWORK MAIL

XSEN:	MOVEI A,[ASCIZ ⊗SEND/NOMAIL⊗]
	MOVEM A,NTMLCM#
	MOVEI A,.XSEN		;SEND/N
	JRST MAILCM

XSEM:	MOVEI A,[ASCIZ ⊗SEND/YESMAI⊗]
	MOVEM A,NTMLCM
	MOVEI A,.XSEM		;SEND/Y
	JRST MAILCM

XMAS:	MOVEI A,[ASCIZ ⊗SEND/MAIL⊗]
	MOVEM A,NTMLCM
	MOVEI A,.XMAS		;SEND/M
	JRST MAILCM

MAIL:	MOVEI A,[ASCIZ ⊗MAIL⊗]
	MOVEM A,NTMLCM
	MOVEI A,.MAIL		;MAIL
MAILCM:	SETZM GOTFRM
	RELEAS FIMP,3		;flush any output file we were writing
	TRZ FLG,17		;TURN OFF FLG BITS FOR COMMAND
	IORI FLG,(A)		;SET WHICH COMMAND WE'RE DOING
	MOVEI B,6		;CODE FOR MAIL STORE
	MOVEM B,STORTYPE
	SETOM EOFMAI#		;SET FLAG FOR DIEOF
	SETOM FSTDST#		;flag no dests seen yet
	PUSHJ P,SETMFL		;SET MAIL FILE NAME
	PUSHJ P,ILDDEV		;OPEN FILE FOR OUTPUT
	 JRST ILDERR
	TLO FLG,(MEOFBT)	;FLAGS MAIL FOR DIEOF
	PUSHJ P,GETFRM		;get reverse path into REVPTH
	 JRST MAILER		;bad form, error reply already made
	PUSHJ P,WRHDR		;write .FTP file header (mail cmd)
	SETOM GOTFRM#		;flag MAIL cmd seen
	POPJ P,

;Here on some syntax error in the MAIL From: command.
MAILER:	RELEASE FIMP,3		;flush output file
	SETZM REVPTH		;no valid reverse path now
	POPJ P,

;Get the sender field out of the MAIL From: line (the part in brackets).
;Skips on success.  On syntax error, send error reply and take direct return.
GETFRM:	PUSHJ P,SKPSPG		;START SCANNING HIS INPUT
	MOVE B,[POINT 7,[ASCIZ/from:/]]
	PUSHJ P,CHKSTR		;make sure starts with "from:"
	 JRST [REPMES (501 "From:" not found in command.)]
	PUSHJ P,SKPSGL		;skip spaces again
	CAIE A,"<"		;> ;path must start with left bracket
	 JRST [REPMES (501 "From:" not followed by "<".)] ;> match bracket
	TLZ FLG,QUOTEF		;no quoting in progress yet
	SETZM REVPTH		;clear any previous reverse path
	MOVEI C,MAXPTH		;max length string we can store
	SKIPA B,[POINT 7,REVPTH] ;byte ptr for storing reverse path
GETFRL:	IDPB A,B		;store new char in buffer
GETFRS:	PUSHJ P,GETCHR		;get a char from the command
	CAIN A,42		;double quote?
	JRST [	TLC FLG,QUOTEF	;set or clear quoting flag
		JRST GETFNQ]	;on to next char
	TLNE FLG,QUOTEF		;skip unless quoting
	JRST GETFRQ		;quoting, allow right bracket and spaces
	CAIN A,76		;right bracket?
	JRST GETFRX		;yes, end of sender field--end of line next
	CAIE A,11
	CAIN A," "
	JRST GETFRS		;ignore spaces and tabs that aren't quoted
GETFRQ:	CAIE A,15		;(match < below)
	CAIN A,12		;check for end of line without right bracket
	JRST [REPMES(501 Reverse-path doesn't end with ">".)]
	CAIE A,"\"		;quoting char?
	JRST GETFNQ		;no
	SOJLE C,GETFRE		;yes, jump if path too long now
	IDPB A,B		;stuff quoter into string
	PUSHJ P,GETCHR		;get quoted char, for stuffing into string
GETFNQ:	SOJG C,GETFRL		;loop unless string too long
GETFRE:	SETZM REVPTH
	REPMES (501 Reverse-path too long.)

;Here when have seen right bracket ending reverse path -- should be crlf next.
GETFRX:	MOVEI A,0		;terminate sender string
	IDPB A,B		; with null (don't keep brackets)
	PUSHJ P,SKPSPG		;skip following spaces, get CR
	CAIE A,15		;command line end with CR?
	JRST [REPMES (501 Extraneous text after "From:<...>" and before carriage return.)]
	PUSHJ P,GETCHR		;get char after CR
	CAIN A,12		;LF?
	JRST OK250		;yup, all done, don't store CRLF
	REPMES (501 Linefeed missing after carriage return ending command.)

OK250:	PUSHJ P,IMPSTR
	ASCIZ/250 OK
/
	JRST CPOPJ1

NODEST:	RELEAS FIMP,3
	SETZM GOTFRM
	REPMES (503 You forgot to tell me whom to mail to -- use RCPT before DATA.)

DATA:	SKIPN GOTFRM		;any MAIL cmd seen?
	JRST NOFROM		;nope, lose
	SKIPGE FSTDST		;skip if any dests seen
	JRST NODEST		;no dests
	PUSHJ P,WSCRLF		;close first page of .FTP file
	PUSHJ P,RCVD		;insert line saying when Received and from where
	SETZM GOTFRM		;no more recipients allowed
	PUSHJ P,FLUSCS		;BH 7/31/80 So MAIL @FOO[A,B] reads past crlf
	MOVEI B,1		;DI
	PUSHJ P,GETSEA		;SET TYPE AND BYTE SIZE
NMAIL:	PUSH P,E
	PUSHJ P,IMPSTR
	ASCIZ /354 What's shakin'?  End text with <crlf>.<crlf>
/
	POP P,E
; here at every new mail line
MAILIN:	PUSHJ P,RGETCH		;CHARACTER OF MAIL
	CAIE A,"."		;".", MAY BE END OF MSG
	 JRST NODOT
	PUSHJ P,RGETCH		;SEE
	CAIN A,15		;if not end of mail, we flush leading dot anyway
	 JRST EOMAIL		;END OF MAIL
;here with each new char
NODOT:	PUSHJ P,SWRTCH
	CAIN A,12		;END OF LINE?
	 JRST MAILIN
	PUSHJ P,RGETCH
	JRST NODOT

EOMAIL:	TLZA FLG,LFSEEN
MAIL91:	 TLZA FLG,LFSEEN
	  PUSHJ P,RGETCH	;GET THE LF
	RELEASE	FIMP,
	PUSHJ P,IMPSTR
	ASCIZ /250 Thanks for the blurb
/
	MOVEI E,RMDWAK
	WAKEME E,		;wake up remind phantom to deliver the mail
	 JFCL
	SKIPN QUITNG		;IF TRIED TO QUIT, TRY
	 POPJ P,		; AGAIN (MULTIPLE-SUICIDE MODE)
	JRST BYE1

SETMFL:	MOVEM F,RMLF#
	MOVEM E,RMLE#
	MOVEM D,RMLD#
	ACCTIM A,		;HIGHLY MNEMONIC FILE NAME
	DPB A,[POINT 12,A,29]	;SHIFT RH BY 6 BITS
	MOVEM A,RMDFIL
	PJOB A,
	DPB A,[POINT 6,RMDFIL,35]
	INIT UFDC,217
	 ('DSK')
	 0
	 JRST QUIT
RMDLK:	MOVE A,RMDSYS
	MOVEM A,RMDFIL+3
	LOOKUP UFDC,RMDFIL
	 SKIPA A,RMDFIL+1
	JRST RMDAOS
	TRNE A,-1
	JRST RMDAOS
	MOVE F,RMDFIL
	HLLZ E,RMDFIL+1
	MOVE D,RMDSYS
	MOVSI C,'DSK'
	RELEAS UFDC,
	POPJ P,

RMDAOS:	MOVEI A,100
	SUBM A,RMDFIL		;USED TO BE AOS, BUT SOS IS SAFER
				;NOT REALLY SOS DUE TO JOB BUT THIS
				;PROGRAM IS SUCH A PIECE OF SHIT ALREADY
				;ANOTHER TURD WON'T HURT
	JRST RMDLK

RMDFIL:	0
	'FTP   '		;extension to use to write cmd file for MAIL
	0
	0			;PPN stuffed in here from cell called RMDSYS

WRHDR:	MOVE B,[PUSHJ P,WRTCHR]
	MOVEM B,OUTINSTR
	MOVE F,RMLF
	MOVE E,RMLE
	MOVE D,RMLD
	MOVE B,NTMLCM
	PUSHJ P,WRTSTR		;COMMAND AND SWITCH
	MOVEI B,[ASCIZ ⊗/FROM↓⊗]
	PUSHJ P,WRTSTR
	SKIPE REVPTH		;DID HE IDENTIFY HIMSELF?
	JRST WHDFRM		;YES, USE HIS OWN ID IN HEADER
	MOVEI B,[ASCIZ / host /]
	PUSHJ P,WRTSTR
	MOVEI B,HSTSTR
	PUSHJ P,WRTSTR
WHDFRB:	MOVEI B,[ASCIZ /↓ /]
	PUSHJ P,WRTSTR
	POPJ P,

WSCRLF:	MOVEI B,RCDCR
	PUSHJ P,WRTSTR		; <CRLF>
	MOVEI A,14
	PUSHJ P,WRTCHR
	POPJ P,

WHDFRM:	MOVEI B,REVPTH
	PUSHJ P,WRTSSP
	JRST WHDFRB

RCDCR:	ASCIZ	/
/

WRTSSP:	HRLI B,(<POINT 7,0>)
WRTSS1:	ILDB A,B
	CAIE A," "		;DISCARD LEADING SPACES AND TABS
	CAIN A,11		; IN NETWORK FROM: AND SUBJECT: LINES
	JRST WRTSS1
	JRST WRTST2

WRTSTR:	HRLI B,(<POINT 7,0>)
WRTST1:	ILDB A,B
WRTST2:	JUMPE A,CPOPJ
	XCT OUTINSTR
	JRST WRTST1

wrtsix:	movei	c,6
wrlp:	movei	a,
	lshc	a,6
	jumpe	a,wrsoj
	addi	a,40	
	pushj	p,wrtchr
	jumpe t,wrsoj
	caie c,4
	jrst wrsoj
	movei a,(t)
	pushj p,wrtchr
wrsoj:	sojg	c,wrlp
	popj	p,
	
SWRTCH:
WRTCHR:	SOSG	FIBUF+2
	OUT	FIMP,
	CAIA
	JRST	IERR4
	IDPB	A,FIBUF+1
	POPJ	P,

CORERR:	POP P,(P)
	PUSHJ P,IMPSTR
	ASCIZ /452 Can't get core for message, aborting.
/
	POPJ P,

IERR4:	PUSHJ	P,IMPSTR
	ASCIZ	/451 Local file system error, mail aborted
/
	JRST	ERRKIL

HELP:	PUSHJ	P,IMPSTR
	 ASCIZ ⊗214-Welcome to sunny California!
214-
214-Implemented Commands: HELO,MAIL,SEND,SOML,SAML,RCPT,DATA,NOOP,RSET,QUIT,HELP.
214 Report problems to Bug-SMTP @ ⊗
	PUSHJ P,IMPSTH		;output our host name (SU-AI, S1-A, ...)
	PUSHJ P,IMPCR		;output crlf
	JRST	FLUSCS

NOMAIL:	MOVE T1,MLDEST
	TLNE T1,-1
	JRST NOPPNM
NOUSER:	PUSHJ P,IMPSTR
	 ASCIZ /550 Unrecognized MAIL recipient: "RCPT /
SYNER2:	PUSHJ P,FLUSCS		;copy rest of command line to return string
	MOVEI E,0
	IDPB E,XXBBP		;terminate recipient line's string
ifn verbose,<
	outstr xxbuf
>;ifn verbose
	MOVE E,[POINT 7,XXBUF]
	PUSHJ P,ASCIIE		;copy recipient line into reply
	PUSHJ P,IMPSTR		;put out ending quote and crlf
	 ASCIZ /"
/
	SETZM XXBBP		;quit collecting recipient line
	SETZM XRFBBP		; No longer copying name.
	POPJ P,

SENERR:	PUSHJ P,IMPSTR
	ASCIZ /450 User not logged in.
/
	SETZM XRFBBP		; No longer copying name.
	JRST FLUSCS

NOPPNM:	PUSHJ P,IMPSTR
	ASCIZ /550 Cannot mail to PPNs--use programmer name.
/
	SETZM XXBBP		;quit collecting recipient line
	SETZM XRFBBP		; No longer copying name.
	JRST FLUSCS

;insert line saying when Received and from where, e.g.:
;Received: from CMU-CS-C by SU-AI with TCP/SMTP; 20 Jan 83  11:42:41 PST
;preserves all ACs but A.
RCVD:	PUSH P,C
	 PUSH P,B
	MOVEI C,[ASCIZ/Received: from /]
	PUSHJ P,MAISTR
	MOVEI C,HSTSTR		;ptr to host name
	PUSHJ P,MAISTR		;print foreign host's name (our version)
	MOVEI C,[ASCIZ/ by /]
	PUSHJ P,MAISTR
	MOVE C,WAITST		;get waits site number
	MOVE C,WATHST(C)	;get ptr to host name string
	PUSHJ P,MAISTR		;print our host name
IFE FTIP,<
	MOVEI C,[ASCIZ $ with NCP/SMTP; $]
>;IFE FTIP
IFN FTIP,<
	MOVEI C,[ASCIZ $ with TCP/SMTP; $]
>;IFN FTIP
	PUSHJ P,MAISTR
	ACCTIM A,		;get current date,,time in secs
	  PUSH P,A		;save time
	HLRZ A,A		;date
	IDIVI A,=31		;day of month-1 to B
	   PUSH P,A
	MOVEI A,1(B)		;day of month
	PUSHJ P,MAIDEC		;print day of month
	MOVEI A," "
	PUSHJ P,SWRTCH
	   POP P,A
	IDIVI A,=12		;month-1 to B, year-=64 to A
	   PUSH P,A
	MOVE B,@MONTAB(B)	;name of month
	AND B,[BYTE (7)177,177,177] ;shorten name of month to three chars
	MOVEI C,B
	PUSHJ P,MAISTR		;print month name
	MOVEI A," "
	PUSHJ P,SWRTCH
	   POP P,A
	ADDI A,=64
	PUSHJ P,MAIDEC		;print year in two digits
	MOVEI C,[ASCIZ/  /]
	PUSHJ P,MAISTR
	  POP P,A		;time in secs
	MOVEI A,(A)		;flush date from LH
	IDIVI A,=60*=60		;hours to A, secs to B
	  PUSH P,B
	PUSHJ P,MAI2DG		;print hours as 2 digits
	MOVEI A,":"
	PUSHJ P,SWRTCH
	  POP P,A
	IDIVI A,=60		;mins to A, secs to B
	  PUSH P,B
	PUSHJ P,MAI2DG		;print mins as 2 digits
	MOVEI A,":"
	PUSHJ P,SWRTCH
	  POP P,A
	PUSHJ P,MAI2DG		;print secs as 2 digits
DAYLIT←←261	;LOWCORE POINTER TO NONZERO IF DAYLIGHT SAVINGS TIME
	MOVEI B,DAYLIT		;FIND OUT IF DAYLIGHT SAVINGS
	PEEK B,			;get ptr to cell
	PEEK B,			;get flag from cell
	MOVEI C,[ASCIZ/ PDT
/]
	SKIPN B			;skip if daylight savings
	MOVEI C,[ASCIZ/ PST
/]
	PUSHJ P,MAISTR		;print time zone and CRLF
	 POP P,B
	POP P,C
	POPJ P,

MAISTR:	HRLI C,440700		;make byte ptr
MAIST2:	ILDB A,C
	JUMPE A,CPOPJ
	PUSHJ P,SWRTCH		;String to .FTP file
	JRST MAIST2

MAIDEC:	IDIVI A,=10		;output decimal number to .FTP file
	HRLM B,(P)
	JUMPE A,.+2
	PUSHJ P,MAIDEC
	HLRZ A,(P)
	ADDI A,"0"
	JRST SWRTCH

MAI2DG:	CAIL A,=10
	JRST MAIDEC		;number already has two (or more) digits
	PUSH P,A
	MOVEI A,"0"
	PUSHJ P,SWRTCH		;print leading zero
	POP P,A
	ADDI A,"0"
	JRST SWRTCH		;print second digit
;SEND LOGGED LOGGE1 LOGTST JBLP JBNXT SENDER JUSTEL MSPG MSNFR MSNSJ SENTTY DPBSTR DPBNAM MSBUFR

;This code is not used!!  Except LOGGED and LOGTST.
repeat 0,<
SEND:	PUSHJ P,LOGTST
	 PUSHJ P,SENDER
	POPJ P,
>;repeat 0

LOGGED:	PUSH P,C
	PUSH P,D
	PUSH P,F
	PUSHJ P,LOGTST
	 JRST LOGGE1
	POP P,F
	POP P,D
	POP P,C
	POPJ P,

LOGGE1:	POP P,(P)
	POP P,F
	POP P,D
	POP P,C
	JRST CPOPJ1

LOGTST:	MOVSI A,377777		;NOTIFY MAIL RECIPIENT IF LOGGED IN
	SKIPE MLDEST		;FORGET THIS IF MAIL TO :FILE
	SETPR2 A,
	JRST CPOPJ1
	MOVE T,400222		;MAX JOB NUMBER
JBLP:	MOVE C,400210		;JBTSTS
	ADDI C,400000(T)
	MOVE C,(C)
	TLNN C,40000
	JRST JBNXT		;NO SUCH JOB
	MOVE A,400236		;JBTLIN
	ADDI A,400000(T)
	MOVE A,(A)
	MOVE D,A
	AOJE D,JBNXT		;DETACHED
	TLNE A,4000		;PTY BIT
	TLNE A,1000		;ARPA BIT
	JRST .+2
	JRST JBNXT
	MOVEI B,(A)
	MOVE F,400211		;PRJPRG
	ADDI F,400000(T)
	MOVE F,(F)		;GET JOB'S PPN
	MOVE D,MLDEST
	TRNE D,-1
	TLZA D,-1
	HLLZS F
	TLNN D,-1		;MASK OUT WILD FIELD
	HRRZS F
	CAME F,D
	JRST JBNXT
	XCT @(P)
JBNXT:	SOJG T,JBLP		;LOOK FOR MORE DESTS
	JRST CPOPJ1

repeat 0,<
SENDER:	TRNN FLG,16		;SENDING?
	JRST JUSTEL		;NO, JUST TELL HIM ABOUT THE MAIL
	MOVEI C,[ASCIZ /;; Network message:
/]
	MOVEI D,B
	TTYMES D,
	 JFCL
	MOVE C,JOBFF		;YES, HERE IS THE MESSAGE
	JRST SENTTY

JUSTEL:	MOVE A,[POINT 7,MSBUFR]	;B HAS DEST DEVICE
	MOVEI C,[ASCIZ /;; →→→ Network mail for /]
	PUSHJ P,DPBSTR		;BUILD UP MESSAGE
	HLLZ C,MLDEST
	JUMPE C,MSPG
	PUSHJ P,DPBNAM
	MOVEI C,","
	IDPB C,A
MSPG:	HRLZ C,MLDEST
	JUMPN C,.+2
	HRLZI C,'*  '
	PUSHJ P,DPBNAM
IFN FTFRM,<
	TLNN FLG,MFRDUN		;IF "FROM" LINE FOUND,
	JRST MSNFR		; WE WILL INCLUDE IT HERE
>;IFN FTFRM
IFE FTFRM,<
	SKIPN REVPTH			;DID HE IDENTIFY HIMSELF?
	JRST WHDFRM			;YES, USE HIS OWN ID IN HEADER
>;IFE FTFRM
	MOVEI C,[ASCIZ / from /]
	PUSHJ P,DPBSTR
	MOVEI C,REVPTH
	PUSHJ P,DPBSTR
MSNFR:
IFN FTMSJ,<
	TLNN FLG,MSJDUN		;IF "SUBJECT" LINE FOUND,
	JRST MSNSJ		; WE WILL INCLUDE IT HERE
	MOVEI C,11
	IDPB C,A
	MOVEI C,MSJBUF
	PUSHJ P,DPBSTR
>;IFN FTMSJ
MSNSJ:	MOVEI C,[ASCIZ / ←←←
/]
	PUSHJ P,DPBSTR
	MOVEI C,0
	IDPB C,A		;MAKE IT ASCIZ
	MOVEI C,MSBUFR
SENTTY:	MOVEI D,B
	TTYMES D,		;SEND IT
	JFCL
	BEEP B,
	POPJ P,

DPBSTR:	HRLI C,440700		;DEPOSIT ASCIZ C IN BPT A
	ILDB E,C
	JUMPE E,CPOPJ
	IDPB E,A
	JRST .-3

DPBNAM:	JUMPE C,CPOPJ
	TLNE C,770000
	JRST .+3
	LSH C,6
	JRST .-3
	MOVE D,[POINT 6,C]
	ILDB E,D
	JUMPE E,CPOPJ
	ADDI E,40
	IDPB E,A
	JRST .-4

MSBUFR:	BLOCK 20
>;repeat 0
;VALID VALCL1 MFDLP MFDLP1 VWINS VLDONE GETMFD GTM1CH MFDIN MFDIN1 VTRYFT MOPEN MBUF MFDNAM MFDNAM NOMFD VSXCHR VALFIL VALFPP

COMMENT ⊗
	Modified 8/2/80 by BH, to use VALDAT[RMD,SYS] instead of mfd
for validation.  VALDAT's first record is an index into the rest of
the file for USETIing for extra speed; the rest is sorted PRGs from
the mfd.  Don't believe any MFDxxx labels, it's really reading VALDAT. ⊗

VALID:	SKIPN T1,MLDEST		;ALWAYS OK TO :FILE
	JRST VALFIL		; IF THE PPN EXISTS.  BH 8/17/80
	SKIPE FWDING		;ALWAYS OK IF FORWARDING
	JRST VWINS
	TLNE T1,-1		;Cannot mail to prj,prg now
	JRST VLDONE		;Nor to prj,*
	MOVE T1,[POINT 6,MLDEST,17]
VALCL1:	MOVE T2,T1
	ILDB T3,T1
	JUMPE T3,VALCL1
	MOVEM T2,FBPINI
	MOVE T2,[PUSHJ P,VSXCHR]
	MOVEM T2,FBPXCT
	PUSHJ P,TRYFOR
	 JRST VWINS		;FORWARDING WINS
	MOVSI C,'DSK'
	PUSHJ P,GETMFD
	 JRST NOMFD
MFDLP:	PUSHJ P,MFDIN		;GET UFD NAME
	 JRST VTRYFT		;EOF
COMMENT ⊗
	MOVE T2,T1
	MOVEI T1,UFDN-1		;FLUSH THE REST OF THE ENTRY
	MOVEM T1,DIRFLC
MFDLP1:	PUSHJ P,MFDIN
	 JRST VTRYFT
	SOSLE DIRFLC
	JRST MFDLP1
	JUMPE T2,MFDLP		;IGNORE ZERO PPN
	MOVE T1,MLDEST
;	TLNN T1,-1
	HRRZS T2
;	TRNN T1,-1
;	HLLZS T2
	CAME T1,T2
⊗
	CAME T1,MLDEST
	JRST MFDLP
VWINS:	AOS (P)
VLDONE:	RELEAS .MFD,
	POPJ P,

GETMFD:	MOVEM C,MOPEN+1
	OPEN .MFD,MOPEN		;CHECK DEST LIST AGAINST MFD
	 POPJ P,
	PUSH P,JOBFF
	MOVEI T1,MFDIBF
	MOVEM T1,JOBFF
	INBUF .MFD,2
	POP P,JOBFF
;;;	MOVE T1,MFDNAM
	MOVE T1,['MAISYS']
	MOVEM T1,MFDNAM+3
	LOOKUP .MFD,MFDNAM
	 POPJ P,
	INPUT .MFD,		;READ VALDAT INDEX
	MOVE T1,MLDEST		;THING TO CHECK IN INDEX
	TRNN T1,777700		;SINGLE-CHAR?
	 JRST GTM1CH		;YES, START AT BEGINNING OF DATA
	MOVEI T2,=27		;BEGINNING OF 3-CHAR STUFF IN INDEX
	TRNN T1,770000		;TWO-CHAR?
	 TDZA T2,T2		;YES, START AT BEGINNING OF INDEX
	LSH T1,-6		;NO, FIRST CHAR IS OVER HERE
	LSH T1,-6		;RIGHT ADJUST FIRST CHAR
	SUBI T1,'A'
	JUMPGE T1,.+2
	MOVNI T1,1		;ANYTHING BELOW A IS -1
	ADDI T2,1(T1)		;FINAL INDEX POSITION
	MOVE T1,MBUF+1
	IBP T1			;I FORGET WHAT THE BPT LOOKS LIKE INITIALLY
	ADDI T2,(T1)		;THIS IS POINTER TO INDEX WORD IN CORE
	USETI .MFD,@(T2)
GTM1CH:	SETZM MBUF+2
	JRST POPJ1

MFDIN:	SOSG MBUF+2		;READ A WORD FROM MFD
	IN .MFD,
	JRST MFDIN1
	STATO .MFD,20000
	JRST NOMFD
	POPJ P,
MFDIN1:	ILDB T1,MBUF+1
	JRST POPJ1

VTRYFT:	MOVE T1,MLDEST
	TLNE T1,-1		;IF DEST ISN'T JUST PRG,
	JRST VLDONE		;WE'VE HAD IT
	JRST TRYFAC		;BUT IF SO GIVE FACT.TXT A CHANCE

MOPEN:	10
	SIXBIT /DSK/
	XWD 0,MBUF
MBUF:	BLOCK 3
COMMENT ⊗
MFDNAM:	SIXBIT /  1  1/
	SIXBIT /UFD/
	0
	SIXBIT /  1  1/
⊗
MFDNAM:	'VALDAT'
	0
	0
	SIXBIT /MAISYS/

NOMFD:	REPMES (451 System error, can't read master user list.)

VSXCHR:	MOVEI A,0
	TLNN F,770000
	POPJ P,
	ILDB A,F
	ADDI A,40
	POPJ P,

VALFIL:	JUMPE D,CPOPJ		;MAIL TO FILE, MUST BE A PPN
	MOVEM D,VALFPP		;SAVE FOR LOOKUP
	MOVE T1,['  1  1']	;PUT MFD PPN IN LOOKUP BLOCK
	MOVEM T1,VALFPP+3
	INIT .MFD,17
	 'DSK   '
	 0
	 POPJ P,		;GOTTA BE A DISK
	LOOKUP .MFD,VALFPP	;LOOK FOR THE UFD
	 JRST VLDONE		;NO, CAN'T MAIL TO FILE IN IT
	JRST VWINS		;YES, OK

VALFPP:	0
	'UFD   '
	0
	'  1  1'
;MFRINI MFRCHR MFRSTR MFRING MFRQTE MFROVR

IFN FTFRM,<
MFRINI:	TLNE FLG,MFRDUN		;INIT FINDING "FROM" LINE IN HEADER
	POPJ P,			;NOTHING TO DO IF FOUND ALREADY
	TLZ FLG,MFRWIN+MFRLUZ
	MOVE MBP,[POINT 7,[ASCIZ /FROM: /]]
	CAIN A," "		;CATCH INITIAL SPACE IN CASE OF PEOPLE LIKE US
	POPJ P,			; WHERE "CATCH" MEANS IGNORE
MFRCHR:	TLNE FLG,MFRLUZ!MFRDUN	;HERE FOR EACH CHAR
	POPJ P,			;IF LOSING, LOSE
	TLNE FLG,MFRWIN		;IF WINNING,
	JRST MFRING		; WIN
	ILDB MCH,MBP		;NOT SURE YET.  GET A TRIAL CHAR
	JUMPE MCH,MFRSTR	;IF NO MORE TO TEST, START WINNING
	CAILE A,140		;STRANGE UC/LC CONVERSION
	ADDI MCH,40		; NAMELY MAKE THE MASK AGREE
	CAIE A,(MCH)		;TEST FOR EQUAL
	TLO FLG,MFRLUZ		;NOPE, LOSING
	POPJ P,

MFRSTR:	TLO FLG,MFRWIN		;THIS IS THE FROM LINE
	MOVE MBP,[POINT 7,MFRBUF]
MFRING:	CAIE A,12		;WINNING LINE:
	CAIN A,15		;IS IT OVER?
	JRST MFROVR		;YUP
	CAIN A,42		;DOUBLE QUOTE?
	JRST MFRQTE		;YES, CHANGE TO TWO SINGLE QUOTES!
	IDPB A,MBP		;SAVE WINNING CHAR
	POPJ P,

MFRQTE:	MOVEI MCH,47		;RIGHT SINGLE QUOTE
	IDPB MCH,MBP		;Two of them to simulate double quote
	IDPB MCH,MBP
	POPJ P,

MFROVR:	MOVEI MCH,0		;FROM FINISHED
	IDPB MCH,MBP		;MARK END OF FROM LINE
	TLZ FLG,MFRWIN+MFRLUZ	;NOT IN PROGRESS ANYMORE
	TLO FLG,MFRDUN		;DON'T LOOK AGAIN
	POPJ P,
>;IFN FTFRM
;MSJINI MSJCHR MSJSTR MSJING MSJQTE MSJOVR

IFN FTMSJ,<
MSJINI:	TLNE FLG,MSJDUN		;INIT FINDING "SUBJECT" LINE IN HEADER
	POPJ P,			;NOTHING TO DO IF FOUND ALREADY
	TLZ FLG,MSJWIN+MSJLUZ
	MOVE MSJ,[POINT 7,[ASCIZ /SUBJECT: /]]
	CAIN A," "		;CATCH INITIAL SPACE IN CASE OF PEOPLE LIKE US
	POPJ P,			; WHERE "CATCH" MEANS IGNORE
MSJCHR:	TLNE FLG,MSJLUZ!MSJDUN	;HERE FOR EACH CHAR
	POPJ P,			;IF LOSING, LOSE
	TLNE FLG,MSJWIN		;IF WINNING,
	JRST MSJING		; WIN
	ILDB MCH,MSJ		;NOT SURE YET.  GET A TRIAL CHAR
	JUMPE MCH,MSJSTR	;IF NO MORE TO TEST, START WINNING
	CAILE A,140		;STRANGE UC/LC CONVERSION
	ADDI MCH,40		; NAMELY MAKE THE MASK AGREE
	CAIE A,(MCH)		;TEST FOR EQUAL
	TLO FLG,MSJLUZ		;NOPE, LOSING
	POPJ P,

MSJSTR:	TLO FLG,MSJWIN		;THIS IS THE SUBJECT LINE
	MOVE MSJ,[POINT 7,MSJBUF]
MSJING:	CAIE A,12		;WINNING LINE:
	CAIN A,15		;IS IT OVER?
	JRST MSJOVR		;YUP
	CAIN A,42		;DOUBLE QUOTE?
	JRST MSJQTE		;YES, CHANGE TO TWO SINGLE QUOTES!
	IDPB A,MSJ		;SAVE WINNING CHAR
	POPJ P,

MSJQTE:	MOVEI MCH,47		;RIGHT SINGLE QUOTE
	IDPB MCH,MSJ		;Two of them to simulate double quote
	IDPB MCH,MSJ
	POPJ P,

MSJOVR:	MOVEI MCH,0		;SUBJECT FINISHED
	IDPB MCH,MSJ		;MARK END OF SUBJECT
	TLZ FLG,MSJWIN+MSJLUZ	;NOT IN PROGRESS ANYMORE
	TLO FLG,MSJDUN		;DON'T LOOK AGAIN
	POPJ P,
>;IFN FTMSJ
;NLST LIST STAT STAT1 STAT2 REJOIN STDONE LIDONE STWILD STWLP STWLP1 DOSTAT STATLP STALP1 STALP2 STAPOK NXTFL1 NXTFL2 NXTFIL STATEOF STATERR STAPRO LISTIT LISTI1 PUT1 PUT6 PUT61 PUT62 sixwrt wrlp wrsoj STATDO

begin sixwrt
GLOBAL A,C
↑sixwrt:movei	c,6
wrlp:	movei	a,
	lshc	a,6
	jumpe	a,wrsoj
	addi	a,40	
	pushj	p,PUTCH1		;WAS ASCIIC, FUCK IT
wrsoj:	sojg	c,wrlp
	popj	p,
bend sixwrt

;;        STAT, FLST -- Send directory status LIST, NLST, STATDO

repeat 0,< ;whole page
NLST:
LIST:	SKIPE DOACTV			;THIS CHECK MUST BE THE FIRST THING
	JRST RETRX0
	TLO FLG,LISTFL			;SET FLAG
	JRST STAT1

STAT:	SKIPE	DOACTV			;DON'T DO IT IF THINGS ARE HAPPENING
	 JRST	 RETRX0
	TLZ FLG,LISTFL			;CLEAR LIST FLAG
STAT1:
IFN FTREQL,<
	SKIPN USEROK		;logged in?
	JRST MUSTLG		;nope, lose
>;IFN FTREQL
	PUSHJ	P,GPPFIL		;GET A FILE OR PPN
	 JRST STORX1
	JUMPN	D,STAT2			;IF NO NAME, USE CURRENT
	MOVE	D,ALIPPN
STAT2:	MOVEM D,STAPPN#			;SAVE PPN FOR HEADER
	MOVEM D,STAPP1#			;SAVE AGAIN FOR WILD PPN HACK
	MOVEM C,STADEV#
	JUMPN F,.+2
	MOVSI F,'*  '			;GFN SOMETIMES ZEROS IT WRONGLY
	MOVEM F,STANAM#			;STAT TAKES FN AND EXT TOO
	MOVEM E,STAEXT#
	PUSHJ	P,FLUSCS		;FLUSH USER ID LINE
	MOVEI A,2			;SET LOCAL BYTE TYPE
	MOVEM A,DOTYPE
	MOVEI A,=36			;AND 36-BIT BYTES
	MOVEM A,DOBS
	TLNE FLG,LISTFL			;IF LIST,
	JRST [SETOM DOACTV↔POPJ P,]	;  WE DO THE REST IN DO MODE
REJOIN:	MOVEI F,(D)			;SEPARATE PRJ AND PRG
	HLRZ E,D
	CAIE F,'*'
	CAIN E,'*'
	JRST STWILD			;WILD PPN
	PUSHJ P,DOSTAT			;NOT WILD PPN, ONLY DO ONCE
STDONE:	TLNE FLG,LISTFL
	JRST LIDONE			;LIST IS DIFFERENT
	PUSHJ	P,IMPSTR
	ASCIZ	/200 That's all, folks!
/
	RELEASE	FOMP,
	POPJ	P,

LIDONE:	PUSHJ P,DOMPSTR
	ASCIZ /252 LIST completed successfully
/
	JRST DOEOF1

STWILD:	MOVE C,STADEV
	PUSHJ P,GETMFD			;WILD PPN, READ THE MFD
	 JRST NOMFD
STWLP:	PUSHJ P,MFDIN
	 JRST STDONE
	MOVE T2,T1			;SAVE ENTRY
	MOVEI T1,UFDN-1			;FLUSH THE REST OF THE ENTRY
	MOVEM T1,DIRFLC
STWLP1:	PUSHJ P,MFDIN
	 JRST STDONE
	SOSLE DIRFLC
	JRST STWLP1
	JUMPE T2,STWLP			;SKIP EMPTY SLOTS
	HLRZ T1,T2			;SEPARATE PRJ AND PRG IN MFD ENTRY
	HLRZ T3,STAPP1
	CAIE T3,(T1)			;COMPARE PRJ
	CAIN T3,'*'
	JRST .+2
	JRST STWLP			;NOPE
	HRRZ T3,STAPP1
	CAIE T3,(T2)			;COMPARE PRG
	CAIN T3,'*'
	JRST .+2
	JRST STWLP
	MOVEM T2,STAPPN			;WIN, SAVE FOR DOSTAT
	PUSHJ P,DOSTAT			;HIT ME
	JRST STWLP

DOSTAT:	MOVE F,STAPPN
	MOVE C,STADEV
	MOVSI	E,'UFD'
	MOVE	D,['1  1']
	PUSHJ P,WAITIL
	MOVEI	B,5			;CODE FOR UFD READ
	MOVEM	B,STORTYPE
	PUSHJ	P,ILDDEV		;OPEN FILE FOR OUTPUT
	 JRST	 STAPRO			;UFD PROTECTION FAILURE
	MOVEI C,20
STATLP:	TLNN FLG,LISTFL
	JRST STALP1			;STAT AND LIST HAVE DIFFERENT WAIT TESTS
	SOJG C,STALP2
	PUSHJ P,SXACTV			;I HATE THIS PROGRAM!
	PUSHJ P,DOWAIT
	MOVEI C,20
	JRST STALP2

STALP1:	SKIPGE SYNCH
	PUSHJ P,CIWAIX			;GIVE ABORT A CHANCE
STALP2:	PUSHJ	P,GETFIL		;C(A) ← BYTE OF DATA FROM FILE
	 JRST	STATERR
	 JRST	STATEOF
	JUMPE	A,NXTFIL		;SKIP ALL IF FILE NO EXIST
	MOVEM A,STAFL1#
	PUSHJ	P,GETFIL		;EXTENSION
	 JRST	STATERR			;NEITHER WILL HAPPEN (READS EVEN # OF FILES)
	 JRST	STATEOF
	HLLZS A
	MOVEM A,STAEX1#
	MOVE B,STAEXT
	CAME B,A
	CAMN B,['*     ']
	JRST .+2			;EXT MATCHES OR WILD
	JRST NXTFL2
	MOVE A,STAFL1
	MOVE B,STANAM
	CAME B,A
	CAMN B,['*     ']
	JRST .+2
	JRST NXTFL2
	TLNE FLG,LISTFL
	JRST LISTIT			;DIFFERENT OUTPUT ROUTINE FOR LIST CMD
	SKIPN STAPPN			;HAVE WE TOLD HIM THE PPN YET?
	JRST STAPOK			;YES
	PUSHJ	P,IMPSTR		;PRINT WHOSE
	ASCIZ	/151 [/
	HLLZ	B,STAPPN
	PUSHJ	P,SIXWRT
	MOVEI	A,","
	PUSHJ	P,ASCIIC
	HRLZ	B,STAPPN
	PUSHJ	P,SIXWRT
	PUSHJ	P,IMPSTR
	ASCIZ	/]
/
	SETZM STAPPN			;FLAG NOT TO DO IT AGAIN
STAPOK:	MOVE B,STAFL1
	PUSHJ	P,IMPSTR
	ASCIZ	/151 /
	PUSHJ	P,SIXWRT		;FILE
	HLLZ	B,STAEX1		; . EXT?
	JUMPE	B,NXTFL1
	MOVEI	A,"."			; . EXT
	PUSHJ	P,ASCIIC
	PUSHJ	P,SIXWRT
NXTFL1:	PUSHJ	P,IMPCR
NXTFL2:	SKIPA	A,[UFDN-2]		;SKIP UFDN-2 WORDS
NXTFIL:	MOVEI	A,UFDN-1		;SKIP UFDN-1 WORDS
	ADDM	A,FOBUF+1		;OK TO DO, SINCE INCREMENTAL # OF
	MOVNS	A			; UFD ENTRIES PER RECORD
	ADDM	A,FOBUF+2
	JRST	STATLP

STATEOF:POPJ P,

STATERR:
	POP P,(P)
	TLNE FLG,LISTFL			;GOTTA DO THE RIGHT MPSTR
	JRST	DOERR
	PUSHJ P,IMPSTR
	ASCIZ /453 STAT incomplete, local file system error
/
	RELEAS FOMP,
	POPJ P,

STAPRO:	MOVE A,STAPP1			;PROTECTION FAILURE:
	TLNN FLG,LISTFL
	CAME A,STAPPN			;IF WILD PPN,
	POPJ P,				;  IGNORE IT
	JRST ILDERR			;ELSE TELL HIM

LISTIT:	MOVE B,STAFL1			;PUT OUT A FILESPEC ON DATA LINK
	PUSHJ P,PUT6
	SKIPN B,STAEX1
	JRST LISTI1
	MOVEI A,"."
	PUSHJ P,PUT1
	PUSHJ P,PUT6
LISTI1:
REPEAT 0,<		; TENEX DOES NOT INCLUDE THE DIRECTORY NAME,
			; AND THIS FUCKS TOPS-20 UP THE ASS!
	MOVEI A,"["
	PUSHJ P,PUT1
	HLLZ B,STAPPN
	PUSHJ P,PUT6
	MOVEI A,","
	PUSHJ P,PUT1
	HRLZ B,STAPPN
	PUSHJ P,PUT6
	MOVEI A,"]"
	PUSHJ P,PUT1
>;END REPEAT 0
	MOVEI A,15
	PUSHJ P,PUT1
	MOVEI A,12
	PUSHJ P,PUT1
	JRST NXTFL2

PUT1:	SOSG DOBUF+2
	PUSHJ P,DOROU3
	IDPB A,DOBUF+1
	POPJ P,

PUT6:	MOVE D,[POINT 6,B]
PUT61:	ILDB A,D
	JUMPE A,PUT62
	ADDI A,40
	PUSHJ P,PUT1
PUT62:	TLNN D,770000
	POPJ P,
	JRST PUT61

STATDO:	PUSH P,DOTYPE			;HERE FROM DO ROUTINE TO START XFER
	PUSH P,DOBS			;IDCON AND ILDDEV USE DIFFERENT VALUES
	SETZM DOTYPE			;BECAUSE WE READ UFD IN IMAGE MODE
	MOVEI A,10			;BUT SEND NVT ASCII OVER DATA LINK
	MOVEM A,DOBS
	MOVEI B,0			;RETR FLAG
	PUSHJ P,IDCON			;SET UP NET LINK
	 JRST DOERR
	POP P,DOBS			;WE CONTROL THE NET OUTPUT OURSELF
	POP P,DOTYPE			;  SO WE CAN LEAVE THESE IN ILDDEV MODE
	PUSHJ P,WAITIL			;THIS IS A CROCK
	MOVEI B,7			;WILL CHANGE TO 5 LATER.  FOR STOMES.
	MOVEM B,STORTYP
	MOVE A,STADEV
	MOVEM A,ERRDEV
	MOVE A,STANAM			;SET UP VARS AS IF FROM ILDDEV
	MOVEM A,ERRFIL
	MOVE A,STAEXT
	HLLZM A,ERREXT
	MOVE A,STAPPN
	MOVEM A,ERRPPN
	SETOM HOLDIL			;PROTECT OURSELF
	MOVEI A,DOMP
	PUSHJ P,GSR		;GET PERMISSION TO TALK BACK
	PUSHJ P,ASCII1
	[ASCII /250 /]
	PUSHJ P,STOMES		;SEND OPERATION NAME AND FILESPEC
	MOVE E,[POINT 7,[ASCIZ / started correctly.
/]]
	PUSHJ P,ASCIIE
	SOS IMPSTF
	SETZM HOLDIL
	MOVE D,STAPPN
	JRST REJOIN
>;repeat 0
;RETR RETRX0 ASCERR

repeat 0,< ;whole page

;;	RETR ROUTINE

RETR:	SKIPE	DOACTV
	JRST	RETRX0
IFN FTREQL,<
	SKIPN USEROK		;logged in?
	JRST MUSTLG		;nope, lose
>;IFN FTREQL
	TLZ FLG,LISTFL	;NOT LIST COMMAND
	MOVEI B,0	;DO FLAG
	PUSHJ P,GETSET	;SET UP TYPE, BYTE SIZE
	 JRST ASCERR	;ERROR RETURN, TYPE A NOT BYTE 8
	PUSHJ	P,GFN	;GET FILE NAME
	JRST	RETRX1	;  DIDN'T GET ONE
	PUSHJ P,WAITIL
	MOVEI	B,1
	MOVEM B,STORTYP		;"STOR"TYP IS NOW REALLY ILD-TYPE
	SETOM HOLDIL
	PUSHJ	P,ILDDEV	;INITIALIZE LOCAL DATA DEVICE
	JRST	ILDERR
	MOVEM	F,DOACS+F	;WHAT??????????????????????????
;	MOVEM	F,DOACS+F	;??????????????????????????????
;	MOVEM	F,DOACS+F
;	MOVEM	F,DOACS+F
	SETOM	DOACTV
	JRST	FLUSCS
RETRX0:	PUSHJ	P,IMPSTR
	ASCIZ	/505 You are already RETRing
/
	JRST	FLUSCS

ASCERR:	PUSHJ	P,IMPSTR
	ASCIZ	/457 TYPE A must be BYTE 8
/
	JRST	FLUSCS
>;repeat 0
;WHICHA WHICHB TYPE TYPEUN TYPEOK TYPEGO MODE MODEUN MODEOK STRU XRSQ

repeat 0,<

;;	TYPE, MODE, STRU  ROUTINES

WHICHA:		;CALL:	MOVEI A,<ASCII CHARACTER>
		;	MOVE  B,[POINT 7,[ASCIZ /<LIST OF ASCII CHARACTERS>/]
		;	PUSHJ P,WHICHA
		;	RETURN HERE, B,C,D CLOBBERED, A=0,1,2 DEPENDING ON POSITION
		;	  IN LIST WHICH MATCHED ORIGINAL C(A), OR A=-1 IF NONE.
	MOVE	C,A
	SETZ	A,
WHICHB:	ILDB	D,B
	JUMPE	D,[SETO A, ↔ POPJ P,]
	CAMN	D,C
	POPJ	P,
	AOJA	A,WHICHB

TYPE:	PUSHJ	P,GETCAP
	MOVE	B,[POINT 7,[ASCIZ /AILPE/]]
	PUSHJ	P,WHICHA
	JUMPL	A,[REPMES (503 Unrecognized type)]
	JRST	.+1(A)
	JRST	TYPEOK
	JRST	TYPEOK
	JRST	TYPEOK
	JRST	TYPEOK
	JRST	TYPEUN
TYPEUN:	REPMES	(506 Unimplemented type)
TYPEOK:	SKIPN	DIACTV
	SKIPE	DOACTV
	JRST	[REPMES	(504 Both data channels busy)]
TYPEGO:	MOVEM A,RTYPE		;SAVE REAL TYPE AS RECEIVED
	REPMES	(200 Type OK)

MODE:	PUSHJ	P,GETCAP
	MOVE	B,[POINT 7,[ASCIZ /SBTH/]]
	PUSHJ	P,WHICHA
	JUMPL	A,[REPMES (503 Unrecognized mode)]
	JRST	.+1(A)
	JRST	MODEOK
	JRST	MODEUN
	JRST	MODEUN
	JRST	MODEUN
MODEUN:	REPMES	(506 Unimplemented mode)
MODEOK:	SKIPN	DIACTV
	SKIPE	DOACTV
	JRST	[REPMES (504 Both data channels busy)]
	REPMES	(200 Mode OK)

STRU:	PUSHJ	P,GETCAP
	CAIN	A,"F"
	 JRST	[REPMES (200 File structure OK)]
	CAIN	A,"R"
	 JRST	[REPMES (506 Record structure not implemented)]
	REPMES	(503 Unrecognized structure)


XRSQ:	PUSHJ	P,XRSRST		; Always reset state of XRCP.
;;	SETZM	XRFOBP			; Reset R-first too.
	PUSHJ	P,GETCAP
	CAIN	A,"?"
	 JRST	[REPMES (215 R Recipients first please.)]
	CAIN	A,"R"
	JRST	[MOVEM A,XRSQSW		; positive value selects R
		REPMES (<200 Okay, R scheme.>)]
	CAIN	A,"T"
	 JRST	[SETOM XRSQSW		; Select T scheme!!
		REPMES (200 Win!)]
	SETZM XRSQSW			; Don't grok, reset to default.
	REPMES (501 Don't know that scheme.)

>;repeat 0
;DECIN DECIN0 SOCK

repeat 0,<

;;	BYTE, SOCK ROUTINES

DECIN:		;READ A DECIMAL ARGUMENT (TERMINATED BY SPACE OR CR) FROM IMP
		;CALL:	PUSHJ	P,DECIN
		;	ERROR	RETURN	(NON NUMERIC IN ARGUMENT)
		;	NORMAL	RETURN	(C(B) = NUMBER, C(A)=DELIMETER)
	SETZ	B,
DECIN0:	PUSHJ	P,GETCHR
	CAIE	A,15		;CR?
	CAIN	A," "		;SPACE?
	JRST	CPOPJ1		;  YES TO EITHER
	CAIL	A,"0"
	CAILE	A,"9"
	POPJ	P,		;ILLEGAL CHARACTER
	IMULI	B,=10
	ADDI	B,-"0"(A)
	JRST	DECIN0

SOCK:	PUSHJ	P,DECIN
	JRST	[REPMES (501 Bad SOCK argument)]
	CAML	B,[1B4]		;SOCKET NUMBER WILL FIT IN 32 BITS
	JRST	[REPMES	(503 Socket number too big)]
	ILDB	C,[POINT 1,B,35]
	TRC C,1			;FOREIGN COMPLIMENT OF LOCAL DIRECTION
	MOVEM	B,FDRS(C)	;STORE IN FDRS OR FDSS
	CAIE	A,15		;C.R. WAS THE TERMINATING CHR.?
	JRST	SOCK		;  NO, GET ANOTHER ARGUMENT
	REPMES	(<200 SOCK argument(s) OK>)

>;repeat 0
;BYTE BYTE2 BYTE4 BYTE9

repeat 0,<

BYTE:	PUSHJ	P,DECIN
	JRST	[REPMES (501 Bad argument to BYTE)]
	SKIPE	DIACTV
	SKIPN	DOACTV
	CAIA
	JRST	[REPMES	(504 Can't reset byte size - both data channels are busy!)]
	CAILE	B,=255
	JRST	[REPMES	(503 Byte size too big)]
	CAIE B,=8
	CAIN B,=32
	JRST BYTE4		;THESE BYTE SIZES OK
	PUSHJ	P,BYTE9		;IS 36 MOD BYTESIZE = 0?
BYTE2:	JRST	[REPMES (506 Byte size must be 8, 32, or factor of 36)]
BYTE4:	MOVEM B,RBS		;SAVE "REAL" BYTE SIZE
	REPMES	(200 Byte size OK)

BYTE9:	MOVEI	C,=36
	IDIV	C,B		;IS 36 MOD (BYTESIZE) = ZERO?
	JUMPE	D,CPOPJ1	;  YES
	POPJ	P,		;  NO

>;repeat 0
;PASS NOPRVS WRONGP GIVUSR MUSTLG PASFOO USER USER3 ASKPAS USER1 USER4 CWD XCWD ACCT INFREE

repeat 0,<

;	USER, PASS ROUTINES

PASS:	TLNN FLG,(PASSBT)		;Password already given?
	 TLNN FLG,(USREBT)		;User not given?
	  JRST GIVUSR			;Yes, tell him to give user name first
	SETZ T3,			;Read password, no break characters
	PUSHJ P,SIXINL
	TRNN T,77			;Right justified?
	 JUMPN T,[ROT T,-6		;No, try advancing a character
		 JRST .-1]
	MOVEM T,PASMTA+3		;Compare with UFD
	MTAPE .PASS,PASMTA
	 JRST WRONGP
	PUSHJ P,IMPSTR
	ASCIZ/230 Password OK, happy hacking
/
	MOVE T3,PPNTMP			;Copy saved PPN
	MOVEM T3,UPPN
	MOVEM T3,ALIPPN			;Set alias, too
	HRRZM T3,UPRG			;SAVE FOR CAME WRT MASPRV IN ILDDEV
	SETZM PRIVS			;NO PRIVILEGES YET
	MTAPE .PASS,PRVMTA		;READ PRIVILEGES
	 JRST NOPRVS
	MOVE T3,PRIVWD			;GET PRIVS FROM UFD
	MOVEM T3,PRIVS			;SAVE THEM
	SETZM PASWD			;JUST IN CASE WE HAVE INF
NOPRVS:	TLO FLG,(PASSBT)
IFN FTREQL,<
	SETOM USEROK			;note password given
>;IFN FTREQL
	RELEASE .PASS,
	JRST	FLUSCS
WRONGP:	PUSHJ P,IMPSTR
	ASCIZ/431 Password rejected.  Shame on you.
/
	MOVE T3,['NETSYS']
	MOVEM T3,UFDFIL
	MOVE T3,[SIXBIT/  1  1/]
	MOVEM T3,UFDFIL+3
	INIT .PASS,17
	 SIXBIT/DSK/
	 0
	 JRST ERRKIL
	LOOKUP .PASS,UFDFIL
	 JRST ERRKIL
	MOVEM T,PASMTA+3		;Compare with UFD
	MTAPE .PASS,PASMTA
	 CAIA
	  JRST [MOVE T3,PPNTMP		;For FTP debugging
		MOVEM T3,UPPN
		MOVEM T3,ALIPPN
		HRRZM T3,UPRG
		SETOM PRIVS
		JRST NOPRVS]
	SOSLE PASTRY			;Too many attempts?
	 JRST FLUSCS			;No, let him/her try again
	MOVEI D,1			;Yes, obviously a password hacker. Flush!
	SLEEP D,			;Wait a sec to send lose message
	JRST ERRKIL			;Now, flush!
GIVUSR:	PUSHJ P,IMPSTR
	ASCIZ	/504 No USER command given
/
	JRST FLUSCS

IFN FTREQL,<
MUSTLG:	PUSHJ P,IMPSTR
	ASCIZ /504 You forgot to log in; must give USER command.
/
	JRST FLUSCS

USEROK:	0			;nonzero if USER command given with password
>;IFN FTREQL

PASFOO:	REPMES (453 System error, can't check password.)

USER:	SETZM PRIVS		;NO PRIVILEGES ANYMORE
	SETOM USRCMD#
	PUSHJ P,GPPN		;GET PPN IN SIXBIT INTO ACCUMULATOR D
	 JRST USER1		;  DIDN'T GET IT
	MOVEM D,UFDFIL		;Check for valid user name
	MOVEM D,PPNTMP		;SAVE HERE FOR PASS
IFE FTREQL,<	;if requiring login, don't allow guest login
	CAME D,['ANONYM']
	 CAMN D,['NETGUE']	;LET THIS ONE IN BUT WITH GUEST STATUS
	  JRST INFREE
>;IFE FTREQL
	MOVE	D,[SIXBIT/  1  1/]
	MOVEM	D,UFDFIL+3
	INIT	.PASS,17
	 SIXBIT/DSK/
	 0
	 JRST PASFOO
	LOOKUP	.PASS,UFDFIL
	 JRST [	HRRZ D,UFDFIL+1		;File not found?
		JUMPE D,USER4		;Yes, unknown user
		CAIN D,2		;Protection violation perhaps?
		JRST USER3		;Yes, can't check password then
		JRST PASFOO]
	SETZM PASMTA+3			;Check for password
	MTAPE .PASS,PASMTA
	JRST ASKPAS			;Something there, ask for it
USER3:	PUSHJ	P,IMPSTR		;None, don't let him/her thru
	ASCIZ	*432 No remote login for that account.
*
	JRST	FLUSCS
ASKPAS:	TLZ FLG,(PASSBT)		;Forget old user
IFN FTREQL,<
	SETZM USEROK			;no password given yet
>;IFN FTREQL
	TLO FLG,(USREBT)		;Remember we got a user name
	MOVEI D,5			;Set number of tries for password
	MOVEM D,PASTRY
	PUSHJ	P,IMPSTR		;Tell user we want a password
	ASCIZ	/330 What's yer password?
/
	JRST	FLUSCS

USER1:	PUSHJ	P,IMPSTR
	ASCIZ	*431 Invalid user name.  Format is PRJ,PRG
*
	JRST	FLUSCS

USER4:	PUSHJ	P,IMPSTR
	ASCIZ	*431 I don't know you
*
	JRST	FLUSCS

CWD:
XCWD:	PUSHJ	P,GPPN		;GET PPN IN SIXBIT INTO ACCUMULATOR D
	JRST	USER1		;  DIDN'T GET IT
	MOVEM D,ALIPPN		;Set user ppn
	PUSHJ P,IMPSTR
	ASCIZ	/200 XCWD command accepted
/
	JRST FLUSCS

ACCT:	PUSHJ P,IMPSTR
	ASCIZ/420 Acct ID not in hash table, add 1 and try again
/
	JRST FLUSCS

IFE FTREQL,<
INFREE:	TLZ FLG,(PASSBT+USREBT)	;SET HIS UPPN BUT NO LOCAL ACCESS.
	MOVEM D,UPPN		;COULD IN PRINCIPLE BE OTHER THAN NETGUE
	MOVEM D,ALIPPN		;IE "SPECIAL GUEST ACCT" HACK
	HRRZM D,UPRG
	PUSHJ P,IMPSTR
	ASCIZ /230 Welcome to sunny California
/
	JRST FLUSCS
>;IFE FTREQL

>;repeat 0
;GETCOM GETCO1 FLUSCS flcs1 GETCO2

;GETCOM,FLUSCS	COMMAND STRING READER

GETCOM:		;CALL:	PUSHJ	P,GETCOM
		;	RETURN HERE, NON-SYNTACTICAL COMMAND
		;	RETURN HERE, C(C) = COMMAND (IN ASCIZ),
		;CLOBBERS A,B,C,D
	TLZ FLG,LFSEEN	;OK TO REALLY READ FROM IMP AGAIN (FLUSCS FAKEOUT HACK)
	MOVNI	D,-5	;MAXIMUM LENGTH OF COMMAND (INCLUDING DELIMITER)
	MOVE	B,[POINT 7,C]
	SETZ	C,
	PUSHJ	P,GETCAP
	CAIE	A," "
	CAIN	A,11
	JRST	.-3	;IGNORE LEADING TABS, SPACES
	CAIA
GETCO1:	PUSHJ	P,GETCAP
	CAIN	A," "		;END OF COMMAND?
	JRST	CPOPJ1		;  YES, SUCCESS EXIT
	CAIN	A,15		;IGNORE CR!
	 JRST	 GETCO1
	CAIN	A,12		;PREMATURE END OF COMMAND LINE?
	JRST	GETCO2		; YES
	IDPB	A,B
	AOJL	D,GETCO1	;LOOP FOR NEXT COMMAND CHARACTER...
	PUSHJ	P,GSRCI
	PUSHJ	P,IMPST0	;  ... UNLESS TOO MANY ALREADY
	ASCIZ	/500 Command more than 4 characters: /
	PUSHJ	P,ASCII1
	C
	PUSHJ	P,IMPCR
	SOS	IMPSTF
FLUSCS:			;FLUSH COMMAND STRING		
ifn verbose,<
	outchr	[173]		;flushing (dcs: 4-12-73)
>;ifn verbose
flcs1:	PUSHJ	P,GETCHR	;GET CHARACTER
	CAIE	A,12		;L.F.?
 	 JRST	FLCS1		;LOOP FOR NEXT
ifn verbose,<
	outchr	[176]
>;ifn verbose
	POPJ	P,		;  YES, EXIT (FAILURE EXIT FROM GETCOM)

;FLUSH WANTS TO SEE SOMETHING PERHAPS
GETCO2:
;	AOS	IBUF+2 		;BACK UP ONE IN COUNTER
;	MOVE	B,[100000,,0]
;	ADDM	B,IBUF+1	; AND IN BUFFER
	MOVEI	A," "		;FAKE THE SPACE
	JRST	CPOPJ1
;GETIDX ANAMES

;GETIDX		CONVERT COMMAND STRING TO INDEX

GETIDX:		;CALL:	PUSHJ	P,GETIDX
		;	RETURN HERE, C(A) = XWD <GARBAGE>,N
		;		N=0 - UNRECOGNIZED COMMAND
	MOVSI	A,-NNAMES
	CAMN	C,ANAMES(A)
	AOJA	A,CPOPJ
	AOBJN	A,.-2
	SETZ	A,
	POPJ	P,

DEFINE	X(A,B) <ASCIZ /A/ ↔ >

ANAMES:	NAMES
NNAMES ←← .-ANAMES
;⊗ PUTCH1 PUTCHR PUTCH2 PUTBUF PUTBU2 PUTBU2 PUTBU3

;;	PUTCHR  -  SEND ASCII CHARACTER OUT ON IMP CONTROL CONNECTION

PUTCH1:
ifn verbose,<
	OUTCHR	A
>;ifn verbose
PUTCHR:		;CALL:	MOVE	A,<ASCII CHARACTER>
		;	PUSHJ	P,PUTCHR
		;	RETURN	HERE ALWAYS, ALL ACCUMULATORS INTACT
	JUMPE	A,CPOPJ		;DON'T OUTPUT NULL CHARACTER
	SOSG	OBUF+2		;ROOM IN BUFFER FOR THIS CHARACTER?
	PUSHJ	P,PUTBUF	;  NO, MAKE ROOM BY OUTPUTTING BUFFER
	PUSH P,A		;JUST IN CASE
;WAITS to ASCII character conversion
	CAIN A,33
	SOJA A,PUTCH2		;not-equals
	CAIN A,175
	MOVEI A,33		;altmode
	CAIN A,176
	MOVEI A,175		;right brace
	CAIN A,32
	MOVEI A,176		;tilde
PUTCH2:	IDPB A,OBUF+1		; STUFF IT IN
	POP P,A
	CAIE	A,12		;IT'S A LINE FEED?
	POPJ	P,		;  NO
	JRST	PUTBUF		;  YES, SEND OUT ENTIRE BUFFER, AND RETURN

PUTBUF:		;CALL:	PUSHJ	P,PUTBUF
		;	RETURN	HERE ALWAYS
		;  OUTPUTS A BUFFER OF ASCII ON THE CONTROL IMP CONNECTION.
	PUSH	P,B		;GET AN ACCUMULATOR
	PUSH P,A
PUTBU2:	LDB B,[POINT 3,OBUF+1,2];PUT MAGIC BITS FOR NULL BYTES
	MOVEI A,1
	LSH A,(B)
	SUBI A,1
	IORM A,@OBUF+1
REPEAT 0,<
PUTBU2:	LDB	B,[POINT 6,OBUF+1,5]
	CAIGE	B,10		;IS WORD FILLED OUT?
	JRST	PUTBU3		;  YES
	SOS	OBUF+2		;  NO, FILL IT OUT WITH NOP'S
	MOVEI	B,202
	IDPB	B,OBUF+1
	JRST	PUTBU2
>
PUTBU3:				;IT MIGHT BE NICE TO PUT A TEST HERE
				;  TO MAKE SURE WE CAN DO THE OUTPUT
				;  WITHOUT HANGING UP FOR ALLOCATION
				;  OR BLOCKED LINK OR WHATEVER.
				;  (IN WHICH CASE, IMPSTR,DIMPSTR,DOMPSTR
				;  SHOULD BE DISTINGUISHED, TO PREVENT
				;  INTERMIXING OF THEIR MESSAGES.)
	POP P,A
	POP	P,B		;RESTORE ACCUMULATOR
	OUT	IMP,		;SEND OUT THE BUFFER
	POPJ	P,		;  SUCCESS, RETURN
	MES	(OUT IMP fails)
; IN THIS CASE, TIS BETTER TO GO ON THAN TO QUIT
	POPJ     P,		;NO MATTER WHAT THE PROBLEM, IGNORE IT
				; OR LET SOMEBODY ELSE FIND IT!
				; (BECAUSE SOME MAIL's CLOSE DOWN BEFORE
				;  ACKNOWLEDGEMENT)
;⊗ GETCHR RGETCH GETCH1 GETCH6 GETCH7 GETCH2 GETCH3 GETCH4 GETCH5 GETCAP FAKELF

;;	GETCHR  -  GET ASCII CHARACTER FROM IMP CONTROL CONNECTION

GETCHR:			;CALL:	PUSHJ	P,GETCHR
			;	RETURN	HERE ALWAYS, C(A) HAS CHARACTER
			;		CLOBBER NO ACCUMULATORS
	TLNE FLG,LFSEEN		;IS THIS COMMAND LINE ALREADY DONE?
	JRST FAKELF		;YUP, KEEP RETURNING LF TO MAKE FLUSCS HAPPY.
RGETCH:	SOSG	IBUF+2		;CHR IN BUFFER?
	JRST	GETCH2		;  NO, DO AN INPUT
GETCH1:	ILDB	A,IBUF+1
;;	CAIN A,200		;DATA MARK?
;;	AOS SYNCH		;  YES, UPDATE COUNT
;;	SKIPL SYNCH		;IF SYNCH IS NEGATIVE, IGNORE INPUT
;;;;;	CAIN	A,202		;NOP?
	CAIL A,200		;TELNET CONTROL?
	JRST	RGETCH		;  YES, GET ANOTHER CHARACTER
	JUMPE	A,RGETCH	;IGNORE NULLS
ifn verbose,<
	SKIPE SILENT		;HIDING THEIR INPUT?
	JRST GETCH6		;YES
	trne	a,200
	outchr	["↑"]
	outchr	a
GETCH6:
>;ifn verbose
;;	TRNE	A,200		;CONTROL CHARACTER?
;;	POPJ	P,		;RETURN, WHATEVER IT IS
;ASCII to WAITS character conversion
	CAIN A,32
	AOJA A,GETCH7		;not-equals
	CAIN A,176
	MOVEI A,32		;tilde
	CAIN A,175
	MOVEI A,176		;right brace
	CAIN A,33
	MOVEI A,175		;altmode
GETCH7:	CAIN A,12
	TLO FLG,LFSEEN		;NO MORE READING UNTIL NEXT GETCOM
	CAIE A,15		;don't save cr or lf
	CAIN A,12
	POPJ P,
	SKIPE XRFBBP		; Are we saving XRCP recipient name?
	SKIPE XRFBZZ		; And not overflowed?
	CAIA
	IDPB A,XRFBBP		; Yes, save char.
	SKIPE XXBBP		; Are we saving recipient line?
	SKIPE XXBZZ		; And not overflowed?
	POPJ P,
	IDPB A,XXBBP		; Yes, save char.
	POPJ P,

GETCH2:	PUSH	P,F		;GET AN ACCUMULATOR
	HRRZ	F,IBUF		;GET POINTER TO BUFFER
	HRRZ	F,(F)		;GET POINTER TO NEXT BUFFER
	SKIPGE	(F)		;INPUT WAITING IN NEXT BUFFER?
	JRST	GETCH3		;  YES
	INTMSK	[0]		;TURN OFF INTERRUPTS
	MTAPE	IMP,[10]	;INPUT WAITING IN FREE STORAGE?
	JRST	GETCH4		;  NO
	INTMSK	[-1]		;  YES, RE-ENABLE INTERRUPTS
GETCH3:	POP	P,F		;RESTORE ACCUMULATOR
	IN	IMP,		;DO THE INPUT
	JRST	GETCH1		;  AND FETCH THE CHARACTER
	JRST	GETCH5		;  OOPS! INPUT FAILED
GETCH4:	INTMSK	[-1]
	POP	P,F		;RESTORE ACCUMULATOR
GETCH5:	PUSHJ	P,CIWAIT
	JRST	GETCH2

GETCAP:	PUSHJ	P,GETCHR	;SAME AS GETCHR, EXCEPT CHANGES
	CAIL	A,"a"		;  LOWER CASE TO UPPER CASE
	CAILE	A,"z"		;  BEFORE RETURNING
	POPJ	P,
	SUBI	A,"a"-"A"
	POPJ	P,

FAKELF:	MOVEI A,12
	POPJ P,
;GSRCI GSR ASCII1 ASCII2 ASCII3 ASCIIY ASCIIE ASCIIC

;	ROUTINES TO OUTPUT ASCII INFORMATION ON CONTROL CHANNEL

;	NOTE: THE PRIVILEGE OF SENDING ASCII OUT ON CONTROL CHANNEL
; IS A "SCARCE RESOURCE", SINCE THE CI,DI AND DO ROUTINES MAY ALL
; TRY TO DO SO SIMULTANEOUSLY.  THE FLAG "INPSTF" GOVERNS THE USE
; OF THESE ROUTINES.
;	IMPORTANT:  WHEN DONE, THE CALLING ROUTINE MUST RELEASE THE
; RESOURCE BY A "SOS IMPSTF" INSTRUCTION.

GSRCI:	MOVEI	A,IMP
GSR:		;Get Scarce Resource
		;CALL:	MOVEI A,<DIMP or DOMP or IMP>
		;	PUSHJ P,GSR
		;	RETURN HERE WITH CONTROL OF SCARCE RESOURCE
	AOSG	IMPSTF		;IS RESOURCE AVAILABLE?
	POPJ	P,		;  YES
	SOS	IMPSTF		;  NO
	CAIN	A,IMP
	PUSHJ	P,CIWAIT
;	CAIN	A,DIMP
;	PUSHJ	P,DIWAIT
;	CAIN	A,DOMP
;	PUSHJ	P,DOWAIT
	JRST	GSR

ASCII1:		;CALL:	PUSHJ P,ASCII1
		;	<ADDRESS OF ONE WORD OF ASCII OR ASCIZ>
		;	RETURN HERE, 0,1,2,3,4,OR 5 CHARACTERS OUTPUT
		;CLOBBERS ACCUMULATORS E,F
	MOVNI	F,5
	PUSH	P,A
	MOVE	E,[POINT 7,0]
	HRR	E,@-1(P)
ASCII2:	ILDB	A,E
	JUMPE	A,ASCII3	;JUMP ON END OF ASCIZ STRING
	PUSHJ	P,PUTCH1	;OUTPUT 1 CHARACTER
	AOJL	F,ASCII2	;LOOP FOR NEXT CHARACTER
ASCII3:	POP	P,A
	JRST	CPOPJ1

ASCIIY:	ILDB	A,E
	JUMPE	A,ASCII3
	PUSHJ	P,PUTCH1
	JRST	ASCIIY

ASCIIE:		;CALL:	MOVE  E,[POINT 7,[ASCIZ /MESSAGE TO GO OUT ON IMP/]]
		;	PUSHJ P,ASCIIE
		;	RETURN HERE ALWAYS, ACCUMULATOR A LOST
	PUSH	P,[.+1]		;PUT <RETURN ADDRESS LESS ONE> ON STACK
	PUSHJ	P,ASCIIY	;THIS IMPLICIT RETURN ADDRESS IS CLOBBERED
	POPJ	P,		;THIS IS THE RETURN FROM ASCIIE

ASCIIC:	PUSH	P,A
	PUSHJ	P,GSRCI		;GET SCARCE RESOURCE -- IMP OUTPUT CONTROL
	POP	P,A
	PUSHJ	P,PUTCH1
	SOS	IMPSTF
	POPJ	P,
;⊗ DIMPSTR DOMPSTR IMPSTR IMPSTF IMPST0 IMPSTN IMPST1 IMPST2 IMPCR IMPSTH WATHST MAXSIT WATHS2 IMPOCT

;;	ANOTHER ROUTINE TO OUTPUT ASCII STRING TO IMP CONTROL CHANNEL

;;	IMPST0 IS A ROUTINE TO OUTPUT AN ASCII STRING TO THE IMP CONTROL
;;CHANNEL.  HOWEVER, SERVERAL DIFFERENT ROUTINES MAY WISH SIMULTANEOUS
;;ACCESS TO IMPST0, WHICH WOULD CAUSE THE MESSAGES GOING OUT TO BE INTER-
;;MINGLED, AND THEREFORE GARBLED.  THUS, INPST0 IS TREATED AS A "SCARCE
;;RESOURCE", AND THE COUNTER "IMPSTF" INDICATES ITS AVAILIBILITY.
;;	SO, IMPST0 HAS 3 ENTRY POINTS: DIMPSTR, DOMPSTR AND IMPSTR.
;;THESE CORRESPOND TO THE 3 ROUTINES DIROUT, DOROUT AND CIROUT.

repeat 0,<
DIMPSTR:AOSG	IMPSTF		;IS IMPSTR AVAILABLE?
	JRST	IMPST0		;  YES
	PUSHJ	P,DIWAIT	;  NO, WAIT AWHILE
	SOS	IMPSTF
	JRST	DIMPSTR

DOMPSTR:AOSG	IMPSTF		;IS IMPSTR AVAILABLE?
	JRST	IMPST0		;  YES
	PUSHJ	P,DOWAIT	;  NO, WAIT AWHILE
	SOS	IMPSTF
	JRST	DOMPSTR
>;repeat 0

IMPSTR:	AOSG	IMPSTF		;IS IMPSTR AVAILABLE?
	JRST	IMPST0		;  YES
	PUSHJ	P,CIWAIT	;  NO, WAIT AWHILE
	SOS	IMPSTF
	JRST	IMPSTR

IMPSTF:	-1	;MINUS ONE MEANS IMPST0 ROUTINE IS AVAILABLE
IMPST0:		;CALL:	PUSHJ P,IMPST0
		;	ASCIZ /STRING TO BE OUTPUT/
		;	RETURN HERE
		;CLOBBERS ACCUMULATOR E
	POP	P,E
	PUSHJ P,IMPSTN		;output string pointed to by E
	SOS	IMPSTF
	JRST	1(E)

;Output to IMP the ASCIZ string pointed to by RH E.
IMPSTN:	HRLI	E,(<POINT 7,0>)
ifn verbose,<
	OUTSTR (E)		;type the message too, in case attached
>;ifn verbose
	PUSH	P,A
IMPST1:	ILDB	A,E
	JUMPE	A,IMPST2
	PUSHJ	P,PUTCHR
	JRST	IMPST1
IMPST2:	POP	P,A
	POPJ P,

IMPCR:	PUSHJ	P,IMPSTR
	ASCIZ	/
/
	POPJ	P,

;routine to output our host name to the IMP
IMPSTH:	MOVE E,WAITST		;get waits site number
	MOVE E,WATHST(E)	;get ptr to host name string
	JRST IMPSTN		;output host name to imp

WATHST:	[ASCIZ/SU-AI/]		;site 0
	[ASCIZ/SU-CCRMA/]	;site 1
	[ASCIZ/S1-A/]		;site 2
	[ASCIZ/New/]		;(always last) unknown sites will just say New
MAXSIT←←.-WATHST

IMPOCT:	IDIVI A,10		;octal output routine
	HRLM B,(P)
	JUMPE A,.+2
	PUSHJ P,IMPOCT
	HLRZ A,(P)
	ADDI A,"0"
	JRST PUTCH1		;output to IMP
;SIXINL SIXINR SIXIN1 SIXIN2 SIXIN3 SIXIN4

		;CR'S ARE IGNORED, ALSO LEADING SPACES AND TABS
		;CALL:	MOVE	T3,[POINT 7,[ASCIZ /<BREAK CHARACTERS>/]]
		;	PUSHJ	P,SIXINL/R
		;	RETURN  HERE ALWAYS,
		;	   C(T) = LEFT/RIGHT JUSTIFIED SIXBIT
		;	   C(T1)= BREAK CHARACTER:
		;	     ILLEGAL 6BIT(1-37),LF(12),OR FROM TABLE(1-177)
SIXINL:	MOVE T2,[POINT 6,T]
	TLOA FLG,LEFTF
SIXINR:	 TLZ FLG,LEFTF
	SETZ	T,		;PUSHJ TO HERE FOR RIGHT NORMALIZATION
	PUSH	P,A		
	PUSH	P,T3		;SAVE POINTER TO BREAK CHARACTERS
	TLZ FLG,QUOTEF		;FLAG NO QUOTING IN PROGRESS
SIXIN1:	ILDB A,XRRBBP		;C(A) GETS CHARACTER from rescanned string
	MOVE	T1,A
	CAIN T1,42		;QUOTE HACKING?
	 TLCA FLG,QUOTEF	;YES, TOGGLE FLAG AND CHECK STATE
	  CAIA
	   JRST SIXIN1
	TLNE FLG,QUOTEF
	 JRST SIXIN3
	CAIE	T1,40
	CAIN	T1,11
	JRST	[JUMPE T,SIXIN1	;IGNORE LEADING BLANKS AND TABS
		 JRST SIXIN4]	;ELSE RETURN
	MOVE	T3,(P)		;T3 ← POINTER TO BREAK CHARACTERS
SIXIN2:	ILDB	A,T3		;A ← BREAK CHARACTER FROM TABLE
	JUMPE	A,SIXIN3	;JUMP ON END OF BREAK TABLE
	CAMN	A,T1		;MATCH WITH INPUT CHARACTER?
	JRST	SIXIN4		;  YES, GO EXIT
	JRST	SIXIN2		;FETCH NEXT BREAK CHARACTER
SIXIN3:	CAIL	T1,"a"
	CAILE	T1,"z"
	JRST	.+2
	TRZ	T1,40		;MAKE LOWER CASE INTO UPPER CASE
	CAIGE	T1,40
	JRST	SIXIN4		;RETURN IF CHAR. HAS NO SIXBIT CODE
	SUBI	T1,40
	ANDI	T1,77
	TLNE FLG,LEFTF		;LEFT JUSTIFIED SIXBIT?
	 JRST [	TLNE T2,770000	;YES, ALREADY HAVE SIX CHARACTERS?
		 IDPB T1,T2	;NO, STASH IT IN
		JRST SIXIN1]
	TLNE	T,770000	;ALREADY HAVE 6 CHARACTERS?
	JRST	SIXIN1		;  YES, FLUSH EXTRA CHARACTERS
	LSH	T,6
	IOR	T,T1
	JRST	SIXIN1		;READ NEXT CHARACTER

SIXIN4:	POP	P,T3		;RESTORE POINTER TO BREAK CHARACTERS
	POP	P,A		;RESTORE ACCUMULATOR A
	POPJ	P,		;AND RETURN
;GFNML GFN GFN0 GFN0A GFN1 GPPN1 GPPN2 GPPN3 GPPN GPPNX GPPWIN GPPFIL MLFLNM MLFLN1 OKMF

;;	CALL:	PUSHJ	P,GFN	;(Get File Name)
;;		ERROR	RETURN
;;		SUCCESS RETURN, C(F) = FILENAME IN SIXBIT
;;				C(E) = EXTENSION IN SIXBIT
;;				C(D) = PPN IN SIXBIT
;;				C(C) = DEVICE IN SIXBIT
;;			CLOBBERS T,T1,T2,T3 ONLY
;;	CALL:	PUSHJ	P,GPPN	;(Get PPN)
;;		ERROR	RETURN
;;		SUCCESS	RETURN, C(D) = PPN IN SIXBIT

;Jump here from MLNB.  POPJs on error, double skips on success.
GFNML:	SETZM MLDEST		;MAIL TO :FILE or via indirect file (@)
	SETOM DISFIL		;distribution file (or direct file)
;;	MOVEM A,MBOXCH		;SAVE # OR @ FOR MAIL COMMAND
	MOVE D,['  PDOC']	;DEFAULT PPN FOR @ FILE
	MOVEI E,0		;NO DEFAULT EXT FOR @ FILE (MAIL handles it)
	CAIE A,"@"		;USE ABOVE DEFAULTS FOR INDIRECT FILE
GFN:	SETZB D,E		;DEFAULT EXT AND PPN
	TLZ FLG,MFNMF
	MOVSI C,'DSK'		;DISK IS ASSUMED DEVICE
	MOVE T3,[POINT 7,[ASCIZ /:.[@/]]
	PUSHJ P,SIXINL
GFN0:	CAIE T1,":"
	JRST GFN0A
	MOVE C,T
	MOVE T3,[POINT 7,[ASCIZ/.[@/]]
	PUSHJ P,SIXINL
GFN0A:	MOVE	F,T		;SET FILE NAME
	CAIE	T1,"."		;EXTENSION IS NEXT?
	JRST	GFN1		;  NO
	MOVE	T3,[POINT 7,[ASCIZ /[@/]]
	PUSHJ	P,SIXINL
;;; This change installed for the benefit of a multiple STOR
;;; from a tenex with longer filenames, so we truncate the ext instead of
;;; refusing the transfer
	HLLZS T
;;;	TRNE	T,-1		;EXTENSION NAME MORE THAN 3 CHARACTERS?
;;;	POPJ	P,		;  YES, ERROR RETURN
	MOVE	E,T		;SET EXTENSION NAME
GFN1:	CAIE	T1,"["		;PPN IS NEXT?
	JRST	CPOPJ2		;  NO, SUCCESS EXIT
GPPN1:			;ENTER HERE FOR PPN ONLY
	MOVE	T3,[POINT 7,[ASCIZ /,]@/]]
	PUSHJ	P,SIXINR
repeat 0,<
	AOSE USRCMD#
	 JRST GPPN2
	CAMN T,['ANONYM']
	 JRST GPPWIN
	CAIN T1,","
	 JRST GPPN2
	TLNE T,-1
	 POPJ P,
	HRLI T,'1'
	JRST GPPWIN
>;repeat 0
GPPN2:	TLNE	T,-1		;PROJECT NAME MORE THAN 3 CHARACTERS?
	POPJ	P,		;  YES, ERROR RETURN
	MOVS	D,T
	JUMPE T,CPOPJ2		;THIS IS NO PPN ON GPPN ENTRY
	CAIE	T1,","		;PROJECT & PROGRAMMER NAMES DELIMITED OK?
	JRST	GPPN3		;  NO, JUST PROJECT CODE
	MOVE	T3,[POINT 7,[ASCIZ /]@/]]
	PUSHJ	P,SIXINR
	TLNE	T,-1		;PROGRAMMER NAME MORE THAN 3 CHARACTERS?
	POPJ	P,		;  YES, ERROR RETURN
	HRR	D,T		;SET PPN
	JRST	CPOPJ2		;SUCCESS RETURN

GPPN3:	TLNE FLG,MFNMF		;IF MLFLNM, TAKE ERROR RETURN SIGH
	POPJ P,
	HRR D,ALIPPN		;GET DEFAULT PROGRAMMER NAME
	JRST CPOPJ2

repeat 0,<
GPPWIN:	MOVE D,T
	JRST CPOPJ1

GPPN:	TLZ FLG,MFNMF
GPPNX:	MOVE T3,[POINT 7,[ASCIZ /[,/]]
	PUSHJ P,SIXINR
	JUMPE T,GPPN1
	AOSE USRCMD#
	 JRST GPPN2
	CAMN T,['ANONYM']
	 JRST GPPWIN
	CAIN T1,","
	 JRST GPPN2
	TLNE T,-1
	 POPJ P,
	HRLI T,'1'
GPPWIN:	MOVE D,T
	JRST CPOPJ1

;; GPPFIL: LIKE GFN BUT ACCEPTS "PRJ,PRG" TO MEAN "*.*[PRJ,PRG]"
;THIS IS COMPLETELY WRONG.

GPPFIL:	MOVSI F,'*  '
	MOVSI E,'*  '
	MOVEI D,0
	MOVSI C,'DSK'
	TLZ FLG,MFNMF
	MOVE T3,[POINT 7,[ASCIZ /:[.,/]]
	PUSHJ P,SIXINL
	CAIE T1,","
	JRST GFN0		;WE HAVE FILENAME
	TRNN T,77		;ELSE RIGHT JUSTIFY
	 JRST [	LSH T,-6
		JRST .-1]
	JRST GPPN2		;AND TREAT AS PPN

;; MLFLNM

MLFLNM:	TLO FLG,MFNMF
	PUSHJ	P,GPPNX
	;falls through
>;repeat 0
MLFLN1:	 JRST	 [MOVE	D,T	;IF NO COMMA WAS FOUND, THAT'S
		  TLNN	T,-1	; OK, MAILING TO PROGRAMMER ONLY
		  JRST	OKMF	; ELSE P OR PN WAS
		  POPJ	 P,]	;TOO LONG
OKMF:	MOVSI	C,'DSK'
	MOVSI	E,'MSG'
	MOVE	F,D	
	MOVE	D,['2  2']	;PERSON.MSG[2,2]
	MOVEM F,MLDEST#		;SAVE PPN FOR HEADER ETC.
	JRST	CPOPJ1		;SUCCESS RETURN
;⊗ GETDST MLNCOP MLNB MLNA MLNMIN MLNMOK COPDOM COPHST COPHS2 COPHOK CHKSTR CHKST0 SKPSPC SKPSP0 SKPSPG SKPSGL MLFILE MLNMFF MLNMF2 MLNMF0 MLDOMX MLHOST MLHOSL MLHOS2 POP12J GET0E1 GET0E2 GET0E3 GET0E4 GET0E5 GET0E6 GET0E7 GET010 GET011 GET012 GET013 GET014 GET015 GET016 GET1E1 GET1E2 GET1ER GET0ER MLHDUN TRYFAC FACTLP FACGE1 FACGE2 FACGE3 FACWRD FACTRY FACTST FACLUZ FACEOF FACRGT FACCHR FACCH1 HRPRIM HRLOOP HRDONE NOFACT FACERR UNRECU AMBIG FACBUF NBUFFR NBUFFX DSTHNM DSTHNX FOPEN FACTXT

;NEW GETDST TO ACCEPT HUMAN BEING NAMES AND LOOK IN FACT.TXT

;Validate destination address
;	PUSHJ P,GETDST
;	  <unimplemented relaying requested>
;	  <syntax error>
;	  <unknown user>
;	<valid-user return>
GETDST:	SETZM SYNCOD#		;clear error code for possible syntax error
	SETZM FWDING#		;FLAG NOT FORWARDING
	SETZM DQUOT#		;flag not quoted dest yet
	PUSHJ P,SKPSPG		;START SCANNING HIS INPUT
	MOVE B,[POINT 7,[ASCIZ/to:/]]
	PUSHJ P,CHKSTR		;make sure starts with "to:"
	 JRST GET1E1		;didn't, syntax error, skip return with error 1
	PUSHJ P,SKPSGL		;skip spaces again
	CAIE A,"<"		;> ;path must start with left bracket
	JRST GET1E2		;syntax error, skip return with error 2
	PUSHJ P,SKPSPG		;skip spaces after left broket
	MOVE B,[POINT 7,XRFBUF]	;set up BPT to
	MOVEM B,XRFBBP		; force GETCH to save name in buffer
	SETZM XRFBZZ		;clear any previous overflow
	IDPB A,XRFBBP		;store first char (read by SKPSPG)
	CAIA			;already have first char of name now
MLNCOP:	PUSHJ P,GETCHR		;get rest of line into buffer (allows rescanning it)
	CAIE A,12		;loop till end of line
	JRST MLNCOP
	SETZB A,DISFIL#		;not distribution file so far
	IDPB A,XRFBBP		;terminate string with null
	SETZM XRFBBP		;stop copying name
	MOVE A,[POINT 7,XRFBUF]	;start scanning at beginning
	MOVEM A,XRRBBP		;set up rescan byte ptr
	ILDB A,XRRBBP		;check first char for special
	CAIE A,"@"		;maybe relaying request
	JRST MLNA		;nope
MLNB:	ILDB A,XRRBBP		;if so, it'll have a colon later
;might	CAIN A,","		;old SMTP version used comma instead of colon
;be ppn	JRST GET0E3		;unimplemented relaying requested
	CAIE A,":"
	JUMPN A,MLNB		;loop unless end of string
	JUMPN A,GET0E3		;unimplemented relaying requested, direct return
MLNA:	AOS (P)			;want to skip at least once (unless reach POP12J)
	MOVE A,[POINT 7,XRFBUF]	;start scanning at beginning
	MOVEM A,XRRBBP		;set up rescan byte ptr
	ILDB A,XRRBBP
	CAIN A,42		;dest quoted?
	JRST [	SETOM DQUOT	;yes, remember that
		MOVEI A," "
		DPB A,XRRBBP	;replace quote with a space (assume local mail)
		ILDB A,XRRBBP	;and get first real char
		JRST .+1]
	CAIN A,"\"		;quoting character?
	JRST [	MOVEI A," "
		DPB A,XRRBBP	;flush quote char for MAIL's benefit
		ILDB A,XRRBBP	;yes (maybe quoting file designation char)
		JRST .+1]
	CAIE A,"#"
	CAIN A,":"		;DEST STARTS WITH COLON
	SKIPA A,["#"]		;(GFNML WILL SAVE THE CHAR FOR LATER
	CAIN A,"@"		; AND WE ACCEPT INDIRECT REQUESTS)
	JRST MLFILE		;  SO IT'S A FILE SPEC, parse it
	MOVE B,[POINT 7,NBUFFR]	;OTHERWISE WE MUST ACCUMULATE HIS NAME
	MOVEI C,0		;CHAR COUNT
MLNMIN:	CAIL A,"A"		;JUST TAKE ALPHAMERICS
	CAILE A,"Z"		;NONE OF THIS FUNNY STRING STUFF
	CAIN A,"-"		;ACCEPT HYPHEN FOR PSEUDO-MAILBOX
	JRST MLNMOK
	CAIL A,"a"
	CAILE A,"z"
	CAIN A,"."		;accept dot in mailbox name for relaying
	JRST MLNMOK
	CAIL A,"0"		;YOU MAY WONDER WHO HAS DIGITS IN HIS NAME
	CAILE A,"9"		;WELL WHAT IF IT'S "MAIL 1,FOO"
	JRST MLNMFF		;WE GOTTA BE ABLE TO RECOVER FROM THAT Y'KNOW
MLNMOK:	IDPB A,B
	ILDB A,XRRBBP
repeat 0,<	;this can't work because of the space it sticks in the middle
		;of the destination name
	CAIN A,"\"		;quoting character?
	JRST [	MOVEI A," "
		DPB A,XRRBBP	;flush quote char for MAIL's benefit
		ILDB A,XRRBBP	;yes (maybe quoting file designation char)
		JRST .+1]
>;repeat 0
	SKIPN NBUFFX		;QUICK & DIRTY OFLO DETECTOR
	AOJA C,MLNMIN
	SETZM NBUFFX		;SO HE CAN TRY AGAIN
	JRST UNRECU		;NAME UNRECOGNIZED IF TOO LONG

;discard domain name, skip on success (always, unless host name already too long)
COPDOM:	TDZA B,B		;don't save output -- discard domain name
;copy host name to DSTHNM, skip on success, no-skip on name too long
COPHST:	MOVE B,[POINT 7,DSTHNM]	;byte ptr for saving destination host name
COPHS2:	CAIL A,"A"		;JUST TAKE ALPHAMERICS and dash
	CAILE A,"Z"		;NONE OF THIS FUNNY STRING STUFF
	CAIN A,"-"		;ACCEPT HYPHEN FOR PSEUDO-MAILBOX or host
	JRST COPHOK
	CAIL A,"a"
	CAILE A,"z"
	JRST .+2
	JRST COPHOK
	CAIL A,"0"		;allow digits in names
	CAILE A,"9"
	JRST CPOPJ1		;end of name -- not letter, digit or hyphen
COPHOK:	IDPB A,B
	ILDB A,XRRBBP
	SKIPN DSTHNX		;QUICK & DIRTY OFLO DETECTOR
	JRST COPHS2		;no overflow, keep scanning
	SETZM DSTHNX		;clear overflow flag
	POPJ P,			;NAME TOO LONG, error return

;compare input string against a constant.  skip if OK.  ignore case.
;B points to constant.  call with A containing first char already.
CHKSTR:	ILDB C,B
	JUMPE C,CPOPJ1		;skip if end of constant
	CAIN C,(A)
	JRST CHKST0		;OK so far
	CAIL C,"A"		;maybe letter of different case
	CAILE C,"z"
	POPJ P,			;different chars, lose
	CAILE C,"Z"
	CAIL C,"A"
	TRC C,40		;invert case of constant string's letter
	CAIE C,(A)
	POPJ P,			;different chars
CHKST0:	PUSHJ P,GETCHR		;next input char
	JRST CHKSTR		;loop

SKPSPC:	ILDB A,XRRBBP
SKPSP0:	CAIE A,40		;  SKIPPING IRRELEVANCIES
	CAIN A,11
	JRST SKPSPC
	POPJ P,

SKPSPG:	PUSHJ P,GETCHR
SKPSGL:	CAIE A,40		;  SKIPPING IRRELEVANCIES
	CAIN A,11
	JRST SKPSPG
	POPJ P,

MLFILE:	PUSHJ P,GFNML		;scan distribution list filename, double skips
	 JRST GET0E4		;bad syntax
	 JRST GET0E5		;can't happen
	LDB A,XRRBBP		;get last char read (delimiter)
	CAIN A,"]"		;end of PPN?
	ILDB A,XRRBBP		;yes, get char after filename
	JRST MLNMF2		;filename OK, now parse rest of line (host)

;End of name.  check for @SU-AI.ARPA (etc.).
;char delimiting name is in A, should be "@" (or ending quote)
MLNMFF:	MOVEI T,0		;delimit copy of name for TRYFOR
	IDPB T,B		;terminate name in NBUFFR
MLNMF2:	SKIPN DQUOT		;are we quoting?
	JRST MLNMF0		;no
	CAIE A,42		;yes, should see ending double quote
	JRST GET016		;but didn't
	MOVEI A," "
	DPB A,XRRBBP		;replace quote with a space (assume local mail)
	PUSHJ P,SKPSPC		;yup, get real delimiter afer the quote
MLNMF0:	MOVE T,XRRBBP		;byte pointer past end of name in XRFBUF
	MOVEM T,CLRBBP#		;save for later (below)
    movem a,saveda#         ;save for debugging
	PUSHJ P,SKPSP0		;skip spaces after mailbox name
	CAIE A,"@"		;name must be followed by "@" and host name
	 JRST GET0E6		;syntax error -- no "@" where expected
	PUSHJ P,SKPSPC		;skip spaces after "@"
	PUSHJ P,COPHST		;copy host name to special block
	 JRST GET0E7		;syntax error, no "@", or host name too long
	MOVEI T,0
	IDPB T,B		;terminate name in DSTHNM
MLDOMX:	CAIN A,"."		;is a domain coming?
	JRST [	ILDB A,XRRBBP
		PUSHJ P,COPDOM	;yes, skip over domain name
		 JRST GET010	;host name (sic) was too long -- can't happen
		JRST MLDOMX ]	;and then look for another domain
	PUSHJ P,SKPSP0		;skip spaces around host name
	CAIE A,76		;host name should be followed by right bracket
	JRST GET011
	MOVEM 11,1+11(P)	;save ACs (NETWRK clobbers 0:11)
	MOVEI 11,1(P)		;source,,dest of BLT from ACs
	BLT 11,1+10(P)		;save only those NETWRK says it clobbers
	ADJSP P,12		;fix stack
	MOVEI 0,DSTHNM		;ptr to host name to look up
	PUSHJ P,HSTNAM		;check host name
	 JRST POP12J		;no such host, restore ACs and take error return
	 JRST POP12J		;ambiguous host, restore ACs and take error return
MLHOST:
	MOVE 1,[-LOURH3,,OURH3]	;aobjn ptr to list of our host nbrs
MLHOSL:	CAMN 0,(1)		;is this one of our host nbrs?
	JRST MLHDUN		;host name was OK, it's ours
	AOBJN 1,MLHOSL		;no, check other numbers
MLHOS2:	PUSHJ P,HSTNXA		;get next host address for name given earlier
	 JRST POP12J		;none, lose
	JUMPN 0,MLHOST		;if non-zero, then try it out
POP12J:	MOVSI 11,-11(P)		;source,,dest of BLT to ACs
	BLT 11,11		;restore ACs 0:11
	ADJSP P,-12		;back up the stack ptr
	SOS (P)			;take direct return after all (AOS'd earlier)
	JRST GET012		;relay request failure -- host name isn't ours

GET0E1:	JSP T,GET0ER	;set error code and take direct return
GET0E2:	JSP T,GET0ER
GET0E3:	JSP T,GET0ER
GET0E4:	JSP T,GET0ER
GET0E5:	JSP T,GET0ER
GET0E6:	JSP T,[	JUMPN A,GET0ER	;give error to foreign mailer unless have a null
repeat 0,< ;bug fixed -- don't halt -- this is foreign mailer's real syntax error
		INTMSK [0]	;disable interrupts for now (connection may die...)
		PUSH P,T
		MOVE T,['GET ME']
		SETNAM T,	;change our name to attract attention
		POP P,T
		HALT $.+1
		INTMSK [-1]	;re-enable after continuing
>;repeat 0
		JRST GET0ER ]
GET0E7:	JSP T,GET0ER
GET010:	JSP T,GET0ER
GET011:	JSP T,GET0ER
GET012:	JSP T,GET0ER
GET013:	JSP T,GET0ER
GET014:	JSP T,GET0ER
GET015:	JSP T,GET0ER
GET016:	JSP T,GET0ER

GET1E1:	JSP T,GET1ER	;set error code and take skip return
GET1E2:	JSP T,GET1ER

GET1ER:	AOS (P)			;set skip return and then store error code
	SUBI T,GET1E1-GET0E1	;adjust PC to other table
GET0ER:	MOVSI T,-GET0E1(T)	;calculate syntax error code
	HRRI T,(A)		;include last character (or whatever) in code
	MOVEM T,SYNCOD		;store for error reply
	POPJ P,

;here if host name checked out OK as ours.
MLHDUN:	MOVSI 11,-11(P)		;source,,dest of BLT to ACs
	BLT 11,11		;restore ACs 0:11
	ADJSP P,-12		;back up the stack ptr
	PUSHJ P,SKPSPC		;name done, skip spaces after right bracket
	JUMPN A,GET013		;jump if junk at end of line -- syntax error
	MOVEI T,0
	DPB T,CLRBBP		;delimit main part of recipient address
	JUMPN A,GET014		;GOTTA END WITH NULL (CRLF flushed by GETCHR)
	SKIPE DISFIL		;skip unless we went to GFNML
	JRST CPOPJ2		;OK, we win
	JUMPE C,GET015		;GOTTA HAVE SOME TEXT!
	AOS (P)			;no more syntax error possibility
	CAIG C,3		;IF ≤3 CHARS STORED,
	JRST HRPRIM		;  TREAT AS JUST PRG (MAYBE WE'LL COME BACK)
	MOVE A,[POINT 7,NBUFFR]	;INITIALIZE POINTERS
	MOVEM A,FBPINI#
	MOVE T2,[ILDB A,F]
	MOVEM T2,FBPXCT#
	PUSHJ P,TRYFOR		;TRY FORWARDING
	 JRST OKMF		;WIN
TRYFAC:	OPEN .MFD,FOPEN		;OTHERWISE WE DO THE FACT.TXT THING
	 JRST [REPMES (451 System error, can't open disk to find user name.)]
	MOVE C,['SPLSYS']
	MOVEM C,FACTXT+3
	LOOKUP .MFD,FACTXT
	 JRST NOFACT		;TROUBLE
	SETZM FACCNT#		;COUNT MATCHES HERE
FACTLP:	MOVE C,[POINT 6,B]	;READ A FACT.TXT ENTRY
	MOVEI B,0		;FIRST PRG IN SIXBIT
FACGE1:	PUSHJ P,FACCHR		;GET DSK CHAR
	 JRST FACEOF
	SUBI A,40
	JUMPLE A,FACGE2
	IDPB A,C
	JRST FACGE1		;CONTINUES TO TAB
FACGE2:	MOVEM B,FACPRG#
	MOVE B,[POINT 7,FACBUF]
	MOVEM B,FACBPT#
FACGE3:	PUSHJ P,FACCHR		;NOW COLLECT NAME
	 JRST FACEOF
	IDPB A,B
	CAIE A,12
	JRST FACGE3
	MOVEI A,0
	IDPB A,B
FACWRD:	MOVE B,[POINT 7,NBUFFR]
	MOVEM B,FCSTBP#		;PREPARE TO START SCAN
FACTRY:	ILDB A,FACBPT		;COMPARISON LOOP
	ILDB B,FCSTBP
	JUMPE B,FACTST		;USER'S NAME DONE, CHECK END OF FILE NAME
	CAIL A,140		;IGNORE CASE DIFFERENCES
	SUBI A,40
	CAIL B,140
	SUBI B,40
	CAIE B,(A)
	JRST FACLUZ		;NOT THE SAME, SORRY
	JRST FACTRY		;SAME, KEEP TRYING
FACTST:	CAIE A,15		;IF NEXT FILE CHAR IS DELIM
	CAIN A,40		;  (COULD FLUSH 40 TO JUST MATCH LAST NAME)
	SKIPA B,FACPRG		;  THEN MATCH, TELL HIM
	JRST FACLUZ
	MOVEM B,FACPPN#		;AND SAVE FOR LATER
repeat 0,<	;SMTP doesn't allow multiple responses to cmds
	PUSHJ P,IMPSTR
	ASCIZ /050 /
	PUSHJ P,SIXWRT		;PUT OUT PRG IN SIXBIT
	PUSHJ P,IMPSTR
	ASCIZ / is the ID for user /
	MOVE E,[POINT 7,FACBUF]
	PUSHJ P,ASCIIE		;GOOD GRIEF
>;repeat 0
	AOS FACCNT		;COUNT MATCHES
	JRST FACTLP		;GET NEXT FILE ENTRY

FACLUZ:	CAIN A,15		;NON-MATCH: IF AT END OF FILE ENTRY,
	JRST FACTLP		;  GET ANOTHER
	CAIN A,40		;IF AT END OF FILE WORD BUT NOT ENTRY,
	JRST FACWRD		;  KEEP SCANNING THIS ENTRY
	ILDB A,FACBPT		;OTHERWISE SCAN THE FILE MORE
	JRST FACLUZ

FACEOF:	CLOSE .MFD,		;END OF FACT.TXT, LET IT GO
	SKIPN C,FACCNT		;HOW MANY MATCHES?
	JRST UNRECU		;NONE, NO SUCH USER
	SOJN C,AMBIG		;TOO MANY
	SKIPA D,FACPPN		;OK, GET THE PRG CODE
FACRGT:	LSH D,-6
	TRNN D,77		;RIGHT ADJUST
	JRST FACRGT
	MOVEM D,MLDEST
	JRST OKMF		;CONTINUE AS USUAL

FACCHR:	SOSG MBUF+2
	IN .MFD,
	JRST FACCH1
	STATO .MFD,20000
	JRST NOFACT
	RELEAS .MFD,
	POPJ P,
FACCH1:	ILDB A,MBUF+1
	JUMPE A,FACCHR
	JRST CPOPJ1

HRPRIM:	MOVEI T1,12		;FAKE DELIM OF LF
	MOVEI T,0		;ACCUMULATE RT-JUSTIFIED NAME
	MOVE B,[POINT 7,NBUFFR]	;  FROM TYPEIN
HRLOOP:	ILDB A,B
	JUMPE A,HRDONE
	CAIL A,140
	SUBI A,40
	SUBI A,40
	LSH T,6
	IORI T,(A)
	TLNN T,77
	JRST HRLOOP
HRDONE:	TLO FLG,MFNMF
	PUSHJ P,GPPN2		;FOOLS JUMP IN...
	 JRST MLFLN1		;AND AGAIN
	TRNE D,-1		; (DON'T ASK.  JUST DON'T ASK.)
	PUSHJ P,FLUSCS
	JRST OKMF		;AND AGAIN

NOFACT:	PUSHJ P,IMPSTR
	ASCIZ /451 Error reading user name file--mail aborted.
/]
	RELEAS .MFD,
FACERR:	POP P,A			;POP RET ADDR TO THWART OLD ERROR MSG AND FLUSCS
	POPJ P,

UNRECU:	PUSHJ P,IMPSTR
	ASCIZ /550 I don't know anybody named /
ifn verbose,<
	outstr nbuffr
>;ifn verbose
	MOVE E,[POINT 7,NBUFFR]
	PUSHJ P,ASCIIE
	PUSHJ P,IMPSTR
	ASCIZ /
/]
	JRST FACERR

AMBIG:	PUSHJ P,IMPSTR
	ASCIZ /550 Ambiguous name rejected, matches multiple users
/]
	JRST FACERR

FACBUF:	BLOCK 20		;BUFFER FOR FACT.TXT NAME
NBUFFR:	BLOCK 1+MAXPTH/5	;BUFFER FOR TYPED-IN NAME (recipient path name)
NBUFFX:	0			;BECOMES NONZERO ON OVERFLOW

DSTHNM:	BLOCK 1+MAXPTH/5	;buffer for host name
DSTHNX:	0			;overflow detector for host name

FOPEN:	0
	SIXBIT /DSK/
	XWD 0,MBUF
FACTXT:	SIXBIT /FACT/
	SIXBIT /TXT/
	0
	SIXBIT /SPLSYS/
;TRYFOR TRYFO1 FORLIN FORCHR FORNO FORTEL FORTE1 FORTE2 FOTAB FORCPY FORCP1 FORCP2 FORZIP FORCHG FORTXT

;TRYFOR	FORWARDING

FF←←14
CR←←15
LF←←12
TAB←←11

TRYFOR:
repeat 0,<
	SKIPE XRFBBP		;Doing XRCP R scheme?
	JRST TRYFO0		;Yes, accept forwarding.
	TRNN FLG,.MAIL
	JRST CPOPJ1		;NO FORWARDING EXCEPT FOR MAIL CMD
TRYFO0:
>;repeat 0
	MOVEM B,FORB#
	MOVEM C,FORC#
	MOVEM D,FORD#
	MOVEM E,FORE#
	MOVEM F,FORF#
	OPEN .MFD,FOPEN
	 JRST [REPMES (451 System error, can't open disk to find user name.)]
	MOVE C,['MAISYS']
	MOVEM C,FORTXT+3
	LOOKUP .MFD,FORTXT
	 JRST NOFACT		;TROUBLE
	PUSHJ P,FORCHG		;CHECK FOR E DIRECTORY
	MOVE T1,MBUF+1
	MOVE T2,(T1)
	CAME T2,[ASCII /COMME/]
	JRST FORLIN
	MOVE T2,1(T1)
	CAME T2,[ASCII /NT ⊗ /]
	JRST FORLIN
	MOVE T2,2(T1)
	CAME T2,[ASCII /  VAL/]
	CAMN T2,[ASCII /INVAL/]
	JRST TRYFO1
	JRST FORLIN

TRYFO1:	PUSHJ P,FORCHG
	JUMPE A,FORLIN
	CAIE A,FF
	JRST TRYFO1
	PUSHJ P,FORCHG
FORLIN:	MOVE F,FBPINI		;NEW LINE OF FILE, REREAD THE USER'S STRING
FORCHR:	JUMPE A,FORZIP		;FORMAT ERROR, EOF IN MID-LINE
	CAIN A,LF
	JRST FORZIP		;FORMAT ERROR, LINE ENDS W/O TAB
	CAIN A,TAB
	JRST FOTAB		;END OF STRING IN FILE
	PUSH P,A
	XCT FBPXCT		;ELSE GET A CHAR FROM USER'S STRING
	POP P,T1
	CAIL T1,140
	SUBI T1,40
	CAIL A,140
	SUBI A,40		;LC TO UC
	CAIE T1,(A)		;MATCH THE FILE?
	JRST FORNO		;NO, GO TO NEXT LINE
	PUSHJ P,FORCHG		;READ CHAR FROM FORWRD.TXT
	JRST FORCHR

FORNO:	PUSHJ P,FORCHG		;SKIP TO END OF LINE
	JUMPE A,FORZIP
	CAIE A,LF
	JRST FORNO
	PUSHJ P,FORCHG		;BEGINNING OF NEXT LINE
	JUMPE A,FORZIP		;DONE IF DONE
	JRST FORLIN		;ELSE CHECK OUT THIS LINE

FORTEL:	AOJN C,FORCPY		;JUMP IF NOT FIRST GRITCH
repeat 0,<	;no multiple responses in smtp
	PUSHJ P,IMPSTR
	ASCIZ /050 Mail for /
	PUSH P,F
	MOVE F,FBPINI
FORTE1:	XCT FBPXCT		;COPY THE FORWARDEE
	JUMPE A,FORTE2
	PUSHJ P,PUTCH1
	JRST FORTE1

FORTE2:	PUSHJ P,IMPSTR
	ASCIZ / will be forwarded to /
	POP P,F
>;repeat 0
	JRST FORCPY

FOTAB:	XCT FBPXCT		;END OF FILE STRING.  END OF USER STRING TOO?
	JUMPN A,FORNO		;NO, NOT A MATCH
	MOVNI C,1		;FLAG FOR INFORMING THE REMOTE END
FORCPY:	PUSHJ P,FORCHG		;COPY A CHAR
	CAIE A,CR
	CAIN A,LF
	MOVEI A,0		;SIMULATE EOF ON EOL
	CAIN A,"⊗"
	JRST FORTEL		;GRITCH MEANS TELL ABOUT THE FORWARDING
	JUMPL C,FORCP1		;JUMP IF NOT NOTIFYING
	CAIN A,"%"
	MOVEI A,"@"		;USE OFFICIAL NETWORK FORMAT (SIGH...)
;;	PUSHJ P,PUTCH1
FORCP1:	JUMPN A,FORCPY		;CONTINUE IF NOT DONE
	JUMPL C,FORCP2
;;	PUSHJ P,IMPCR
FORCP2:	SETOM FWDING		;FLAG FORWARDING
	CLOSE .MFD,
	POPJ P,			;SUCCESS RETURN

FORZIP:	CLOSE .MFD,
	MOVE B,FORB#
	MOVE C,FORC#
	MOVE D,FORD#
	MOVE E,FORE#
	MOVE F,FORF#
	JRST CPOPJ1		;FAILURE RETURN

FORCHG:	PUSHJ P,FACCHR
	 MOVEI A,0
	POPJ P,

FORTXT:	SIXBIT /FORWRD/
	SIXBIT /TXT/
	0
	SIXBIT /MAISYS/
;DIROUT DIROU1 DIROU2 DIRO25 DIROU3 DIERR ICONER DIERR2 DIER2A DIEOF9 DIEOF DIEOFQ DIEOFL DIEOF0 DIEOF1 DIFINI DIEOML DIMLFL DIERR3

repeat 0,< ;whole page

;;	DI ROUTINE  - GET DATA FROM IMP, STORE IN WAITS FILE SYSTEM

;;	ENVIRONMENTAL PREQUISITES FOR CALLING DIROUT:
;;	1)	WAITS FILE SYSTEM IS INITIALIZED, AND HAS BEEN
;;	    "ENTERED".  THE DI ROUTINE WILL STORE THE FILE IN WAITS
;;	    FILE SYSTEM USING BUFFER HEADER "FIBUF".
;;	2)	C(DIMODE) INDICATES MODE OF DATA TRANSFER
;;	4)	C(DITYPE) INDICATES TYPE OF DATA (ARPANET FTP CONVENTIONS)
;;	5)	C(FOTYPE) INDICATES MOVE OF DATA TRANSFER (LOCAL TO 
;;	    WAITS, THIS INDICATES THE WAY OF HANDLING "FIBUF" BUFFER).

;;	WHAT DI ROUTINE DOES:
;;	1)	INITS THE IMP, ON CHANNEL DIMP.
;;	2)	ESTABLISHES DATA CONNECTION WITH FOREIGN USER TELNET.
;;	3)	ACCEPTS DATA FROM IMP, STUFFING IT INTO WAITS FILE
;;	    SYSTEM.
;;	4)	CLOSES DATA CONNECTION AND RELEASES WAITS FILE SYSTEM
;;	    UPON ANY OF THE FOLLOWING:
;;		A)	DATA CONNECTION CLOSED FOR ANY REASON
;;		B)	EOF ARRIVES ON DATA CONNECTION
;;		C)	"DIABORT" FLAG IS FOUND TO BE SET
;;		D)	ERROR IN WAITS FILE SYSTEM

DIROUT:	MOVEI	B,1		;INDICATE DATA DIRECTION "IN"
	PUSHJ	P,IDCON		;INITIALIZE DATA CONNECTION
	JRST	ICONER		;ERROR
;;# DCS 10-15-72 ADD FTP START RESPONSE HERE PER CMU REQUEST
	MOVEI A,DIMP
	PUSHJ P,GSR		;GET PERMISSION TO TALK BACK
	MOVE E,[POINT 7,[ASCIZ /250 Socket to me!
/]]
	PUSHJ P,ASCIIE
	SOS IMPSTF
	SETZM HOLDIL
;;# DCS
	MOVNI FLG2,1
	TLO FLG,MEOFBT
	MOVE	B,[JRST CPOPJ2]	;MOST DATA MODES RETURN SUCCESSFUL WITH ANY BYTE
	MOVE	A,DIMODE	;  BUT TEXT MODE MUST DO AN EOF TEST FIRST
	CAIN	A,2		;ARE WE DOING TEXT MODE TRANSFER?
	MOVE	B,[JRST GETDAE]	;  YES, SPECIAL GLITCH
	MOVEM	B,GETDA0	;PLANT RETURN INSTRUCTION
DIROU1:	HRROI	C,-40
DIROU2:	PUSHJ	P,GETDAT	;C(A) ← BYTE OF DATA FROM IMP
	JRST	DIERR3		;  FAILURE RETURN
	JRST	DIEOF9		;  EOF RETURN
	SKIPN EOFMAI
	JRST DIROU3
	AOJN FLG2,DIRO25
IFN FTFRM,<
	PUSHJ P,MFRINI		;"FROM" LINE FINDER LINE INIT
>;IFN FTFRM
IFN FTMSJ,<
	PUSHJ P,MSJINI		;"SUBJECT" LINE FINDER LINE INIT
>;IFN FTMSJ
	JRST DIROU3

DIRO25:
IFN FTFRM,<
	PUSHJ P,MFRCHR		;"FROM" LINE FINDER CHAR SCANNER
>;IFN FTFRM
IFN FTMSJ,<
	PUSHJ P,MSJCHR		;"SUBJECT" LINE FINDER CHAR SCANNER
>;IFN FTMSJ
DIROU3:
IFN %XRCP,<
	SKIPE XRBPTR
	 JRST [	PUSHJ P,XRCHO
		JRST .+3]	; Bypass PUTFIL & err return.
>
	PUSHJ P,PUTFIL
	 JRST DIERR2
	CAIN A,12
	MOVNI FLG2,1
	AOJL	C,DIROU2
	PUSHJ	P,SXACTV
	PUSHJ	P,DIWAIT
	JRST	DIROU1

DIERR:	PUSHJ	P,DIMPSTR
	ASCIZ	/452 STOR incomplete, data connection closed early.
/
	JRST	DIER2A

ICONER:	PUSHJ P,DIMPSTR
	ASCIZ /454 STOR incomplete, can't connect to your data socket
/
	JRST DIER2A

DIERR2:	PUSHJ	P,DIMPSTR
	ASCIZ	/453 STOR incomplete, local file system error
/
DIER2A:	SETZM EOFMAI		;ERROR.  FORGET ABOUT SPECIAL MAIL STUFF
IFN %XRCP,<
	SKIPE XRBPTR
	 JRST [	PUSHJ P,XRSRST
		JRST DIFINI]
>
	RELEAS FIMP,3		;  BECAUSE WE ARE FLUSHING THE OUTPUT HERE
	JRST DIFINI

DIEOF9:	SKIPN EOFMAI
	 JRST DIEOF
IFN %XRCP,<
	SKIPE XRBPTR
	 JRST [	PUSHJ P,XRSSET		; Finalize saved text stuff.
		PUSHJ P,DIMPSTR
		ASCIZ /252 Text saved.
/
		JRST DIFINI]
>
	USETO FIMP,1			;BACK UP TO WHERE THE COMMAND BELONGS
	PUSHJ	P,WRHDR
DIEOF:	MOVE A,DITYPE		;SPECIAL EOF FOR IMAGE TYPE
	SOJN A,DIEOFQ		;ELSE JUST CLOSE EVERYTHING
	MOVE A,FIWORD		;GET LAST PARTIAL WORD
	PUSHJ P,PUTFI0
	 JFCL			;NEVER MIND ERROR, TOO LATE
DIEOFQ:	RELEASE	FIMP,
	SKIPN EOFMAI
	JRST DIEOF1
	MOVEI A,RMDWAK
	WAKEME A,
	 JFCL
REPEAT 0,<
	MOVE	A,DITYPE
	MOVE	A,FMODES(A)
	MOVEM A,OMLOPN
	OPEN .OLD,OMLOPN
	JRST DIEOF0
	PUSH P,JOBFF
	MOVEI A,OLDIBF
	MOVEM A,JOBFF
	INBUF .OLD,2
	POP P,JOBFF
	LOOKUP .OLD,OMLNAM
	 JRST DIEOF0
DIEOFL:	PUSHJ P,OMLGET		;COPY REST OF FILE
	 JRST DIEOF0		; EOF RETURN
	PUSHJ P,OMLOUT
	JRST DIEOFL
DIEOF0:	RELEAS .OLD,
	PUSHJ P,SEND		;MLFL, NOTIFY RECIPIENT
>;REPEAT 0
DIEOF1:	JUMPL FLG,DIEOML
	PUSHJ P,DIMPSTR
	ASCIZ /252 Finis; /
	PUSHJ P,ERRFN
	PUSHJ P,DIMPSTR
	ASCIZ/
/
DIFINI:	SETZM DIACTV
	RELEASE DIMP,
	SKIPN QUITNG		;IF TRIED TO QUIT, TRY
	 POPJ P,		; AGAIN (MULTIPLE-SUICIDE MODE)
	JRST BYE1

DIEOML:	TRNN FLG,17		;WAS THIS A MAIL&FRIENDS COMMAND, OR MLFL?
	JRST DIMLFL		;MLFL -- succeeds with different code
	PUSHJ P,DIMPSTR
	ASCIZ /256 Thanks for the blurb
/
	JRST DIFINI

DIMLFL:	PUSHJ P,DIMPSTR
	ASCIZ /252 Thanks for the blurb
/
	JRST DIFINI

DIERR3:	PUSHJ	P,DIMPSTR
	ASCIZ	/452 STOR incomplete, error reading data connection
/
	JRST	DIER2A

>;repeat 0
;RMDWAK RMDSYS OMLGET OMLGT1 OMLOUT OMLOPN OMLBUF OMLNAM PUTFIL PUTFI0 PUTFI1 PUTFI2 PUTFI3 PUTFI4 PUTFI5 FIBTSL FIWORD FIBPT

RMDWAK:	'<RMND>'
RMDSYS:	'RMDSYS'
	0

repeat 0,<	;rest of page

OMLGET:	SOSG OMLBUF+2
	IN .OLD,
	JRST OMLGT1
	STATO .OLD,20000
	JRST DIERR2
	POPJ P,			;EOF

OMLGT1:	ILDB A,OMLBUF+1
	JUMPE A,OMLGET
	JRST CPOPJ1

OMLOUT:	SOSG	FIBUF+2		;ROOM IN BUFFER?
	OUT	FIMP,		;  NO, DO AN OUTPUT
	CAIA
	JRST	DIERR2		;    OUTPUT FAILS
	IDPB	A,FIBUF+1	;STUFF DATA BYTE INTO BUFFER
	POPJ P,

OMLOPN:	0
	SIXBIT /DSK/
	XWD 0,OMLBUF
OMLBUF:	BLOCK 3
OMLNAM:	0
	SIXBIT /MSG/
	0
	SIXBIT /  2  2/

;;	CALL:	MOVE	A,<BYTE TO GO INTO LOCAL FILE SYSTEM>
;;		PUSHJ	P,PUTFIL
;;		ERROR	RETURN
;;		NORMAL	RETURN

PUTFIL:	MOVE B,DITYPE		;PROCESSING DEPENDS ON TYPE
	JRST .+1(B)		;DISPATCH
	JRST PUTFI2		;ASCII, DO CHAR TRANSLATION
	JRST PUTFI3		;IMAGE, HAIRY CROCK.  ELSE LOCAL BYTE
PUTFI0:	SOSG	FIBUF+2		;ROOM IN BUFFER FOR THIS BYTE?
	OUT	FIMP,		;  NO, OUTPUT THE BUFFER
	JRST	PUTFI1		;ROOM IN BUFFER, OR SUCCESSFUL OUTPUT
	POPJ	P,		;  ERROR RETURN
PUTFI1:	IDPB	A,FIBUF+1	;PUT BYTE INTO BUFFER
	JRST	CPOPJ1		;SUCCESS RETURN

PUTFI2:	JUMPE A,CPOPJ1		;ASCII, IGNORE NULLS,
	CAIL A,200
	JRST CPOPJ1		;  IGNORE FUNNY NVT CODES,
	CAIN A,176		;  AND TRANSLATE FUNNY CHARS
	MOVEI A,32		;TILDE
	CAIN A,175
	MOVEI A,176		;RIGHT BRACE
	CAIN A,33
	MOVEI A,175		;ALTMODE
	JRST PUTFI0		;NOW NORMAL IO STUFF

PUTFI3:	SKIPE B,FIBTSL		;HAIRY IMAGE MODE WRAPAROUND BYTE CROCK
	JRST PUTFI4
	EXCH A,FIWORD
	PUSHJ P,PUTFI0
	 POPJ P,
	MOVE A,FIWORD
	SETZM FIWORD
	MOVS B,DIBS
	LSH B,6
	IOR B,[POINT 0,FIWORD]
	MOVEM B,FIBPT
	MOVEI B,=36
PUTFI4:	SUB B,DIBS
	MOVEM B,FIBTSL
	JUMPL B,PUTFI5
	IDPB A,FIBPT
	JRST CPOPJ1

PUTFI5:	MOVEI B,0
	MOVE D,FIBTSL
	LSHC A,(D)		;POSITION THE NEW BYTE
	IOR A,FIWORD
	MOVEM B,FIWORD
	PUSHJ P,PUTFI0
	 POPJ P,
	MOVEI A,=36
	ADDB A,FIBTSL
	LSH A,6			;MAKING NEW BPT
	ADD A,DIBS
	LSH A,=24
	HRRI A,FIWORD
	MOVEM A,FIBPT
	JRST CPOPJ1

FIBTSL:	0
FIWORD:	0
FIBPT:	0
>;repeat 0
;GETDAT GETDA1 GETDA0 GETDA2 GETDA3 GETDA4 GETDA5 GETDA7 GETDAC GETDAE

repeat 0,<

;;	GETDAT - GET DATA BYTE FROM IMP DATA CONNECTION

;;	CALL:	PUSHJ	P,GETDAT
;;		RETURN	HERE, ERROR
;;		RETURN	HERE, EOF
;;		RETURN	HERE, C(A) = DTAT BYTE

GETDAT:	SOSG	DIBUF+2		;BYTE IN BUFFER?
	JRST	GETDA2		;  NO, THINK ABOUT DOING AN INPUT
GETDA1:	ILDB	A,DIBUF+1	;GET THE DATA BYTE
GETDA0:	000			;  [JRST CPOPJ2] OR [JRST GETDAE]
GETDA2:	PUSH	P,B		;GET AN ACCUMULATOR TO PLAY WITH
	HRRZ	B,DIBUF		;GET POINTER TO BUFFER
	HRRZ	B,(B)		;GET POINTER TO NEXT BUFFER
	SKIPGE	(B)		;IS THERE DATA IN THAT BUFFER?
	JRST	GETDA3		;  YES, DO AN INPUT
	INTOFF			;TURN OFF INTERRUPTS
	MTAPE	DIMP,[10]	;INPUT DATA WAITING IN FREE STORAGE?
	JRST	GETDA4		;  NO
	INTON
GETDA3:	POP	P,B
	IN	DIMP,
	JRST	GETDA1		;SUCCESSFUL INPUT
	POPJ	P,		;ERROR ON INPUT, GIVE ERROR RETURN
GETDA4:	INTON			;TURN ON INTERRUPTS
	POP	P,B
	MTAPE	DIMP,GETDA7	;GET STATUS OF CONNECTION
	MOVE	A,GETDA7+2	;GET STATUS BITS
	TLNE	A,CLS		;IS SOMEBODY CLOSING THIS CONNECTION?
	JRST	GETDAC		;  YES
GETDA5:	PUSHJ	P,DIWAIT	;WAIT FOR AWHILE, ...
	JRST	GETDA2		;  ... AND TRY AGAIN

GETDA7:	2 ↔ 0 ↔ 0		;DATA BLOCK FOR MTAPE UUO

GETDAC:	MOVE	A,DIMODE	;ARRIVE HERE IF DI CONNECTION COSES
	JRST	.+1(A)		;DISPATCH ACCORDING TO CONNECTION MODE
	JRST	CPOPJ1		;STREAM MODE, GIVE EOF RETURN
	000			;BLOCK MODE, UNIMPLEMENTED
	POPJ	P,		;TEXT MODE, GIVE ERROR RETURN
	000			;HASP MODE, UNIMPLEMENTED

GETDAE:	CAIE	A,301		;ARRIVE HERE WITH BYTE IF DI CONNECTION IS
	JRST	CPOPJ2		;  TEXT MODE, GIVE NORMAL RETURN HERE.
	JRST	CPOPJ1		;  UNLESS EOF, GIVE EOF RETURN HERE.
>;repeat 0
;DOROUT DOROU1 DOROU2 DOROU3 DOEOF DOEOF1 DOEOF2 DOERR OCONER

repeat 0,<

;;	DOROUT - GET DATA FROM LOCAL FILE SYSTEM, TRANSMIT TO IMP

;;	ENVIRONMENTAL PREREQUISITES FOR CALLING DOROUT:
;;	1)	WAITS FILE SYSTEM IS INIT'ED, AND LOOKUP HAS BEEN
;;		DONE.  DOROUT WILL RETRIEVE THE FILE USING BUFFER
;;		HEADER "FOBUF".
;;	2)	C(DOMODE) INDICATES MODE OF DATA TRANSFER.
;;	3)	C(DOTYPE) INDICATES TYPE OF DATA TRANSFER.

;;	WHAT DOROUT DOES:
;;	1)	INITS THE IMP, ON CHANNEL DOMP.
;;	2)	ESTABLISHED DATA CONNECTION WITH FOREIGH TELNET.
;;	3)	READS DATE FROM LOCAL FILE SYSTEM, TRANSMITTING IT
;;		TO THE IMP.
;;	4)	CLOSES DATA CONNECTION ON EOF FROM FILE SYSTEM

DOROUT:	TLNE FLG,LISTFL		;IF THIS IS THE LIST COMMAND,
	JRST STATDO		;  GO BACK TO STAT ROUTINE FOR OUR PART
	MOVEI	B,0
	PUSHJ	P,IDCON		;INITIALIZE DATA CONNECTION
	JRST	OCONER		;  CAN'T MAKE DATA CONNECTION
	MOVEI A,DOMP
	PUSHJ P,GSR		;GET PERMISSION TO TALK BACK
	MOVE E,[440700,,[ASCIZ /250 Look out!  Here comes /]]
	PUSHJ P,ASCIIE
	PUSHJ P,ERRFN
	MOVE E,[440700,,[ASCIZ/
/]]
	PUSHJ P,ASCIIE
	SOS IMPSTF
	SETZM HOLDIL
	SETOM NOEDIR#		;FLAG TO HELP ASCII TYPE FLUSH E DIRECTORY
DOROU1:	HRROI	C,-40
DOROU2:	PUSHJ	P,GETFIL	;C(A) ← BYTE OF DATA FROM FILE
	JRST	DOERR
	JRST	DOEOF
	SOSG	DOBUF+2		;ROOM FOR BYTE IN DOMP BUFFER?
	PUSHJ	P,DOROU3	;  NO, DO OUTPUT TO IMP
	IDPB	A,DOBUF+1	;  YES, PUT IT IN
	AOJL	C,DOROU2	;LOOP FOR NEXT BYTE IF NOT TOO MANY
	PUSHJ	P,SXACTV	;TOO MANY ALL AT ONCE, PAUSE SO THE
	PUSHJ	P,DOWAIT	;  CONTROL LINK CAN GET IT IF IT WANTS
	JRST	DOROU1		;CONTINUE

DOROU3:				;IT MIGHT BE NICE TO PUT A TEST HERE TO
				;  INSURE THAT THE OUTPUT WILL NOT HANG
	OUT	DOMP,
	POPJ	P,
	MES	(OUT DOMP fails)
	JRST	ERRKIL
DOEOF:	PUSHJ	P,DOMPSTR
	ASCIZ	/252 The End
/
DOEOF1:	PUSHJ	P,DOROU3
DOEOF2:	RELEASE	FOMP,
	RELEASE	DOMP,
	SETZM	DOACTV
	SKIPN	QUITNG		;IF TRIED TO QUIT, TRY AGAIN
	POPJ	P,		; (QUITTERS NEVER QUIT QUITTING)
	JRST	BYE1

DOERR:	PUSHJ	P,DOMPSTR
	ASCIZ	/453 RETR incomplete, local file system error
/
	JRST	DOEOF1

OCONER:	PUSHJ P,DOMPSTR
	ASCIZ /454 RETR incomplete, can't connect to your data socket
/
	JRST DOEOF2
>;repeat 0
;GETFIL GETFI0 GETFI1 GETFI2 GETFI3 GETFI4 GETFI5 GETFI6 GETFI7 GETF71 GETFI8 FOBTSL FOWORD FOBPT FOTEMP FOMASK

repeat 0,<	;whole page

;;	GETFIL

;CALL:	PUSHJ	P,GETFIL
;	ERROR	RETURN
;	EOF	RETURN
;	NORMAL	RETURN
; Getfil -- Get data byte from local file system. GETDAT

GETFIL:	MOVE A,DOTYPE		;GETTING FROM FILE IS HAIRY
	CAIN A,1		;  IF IMAGE TYPE
	JRST GETFI3		;  ELSE DROP THROUGH TO STANDARD ROUTINE
GETFI0:	SOSG	FOBUF+2		;DATA BYTE IN BUFFER?
	JRST	GETFI2		;  NO, DO AN INPUT
GETFI1:	ILDB	A,FOBUF+1	;  YES, GET DATA BYTE
	JRST	GETFI6		;    AND RETURN UNLESS ASCII
GETFI2:	IN	FOMP,		;DO AN INPUT
	JRST	GETFI1		;  INPUT WAS SUCCESSFUL
	GETSTS	FOMP,B		;  EOF OR ERROR, GET STATUS BITS IN B
	TRNE	B,IODEND	;EOF?
	JRST	CPOPJ1		;  YES
	MES	(Error detected on FOMP)
	POPJ	P,

GETFI3:	SKIPE A,FOBTSL		;IMAGE MODE: MORE BITS IN THE CURRENT FILE WORD?
	JRST GETFI4		;  YES, CARRY ON
	MOVS A,DOBS		;ELSE CREATE A NEW BPT
	LSH A,6			;BYTE SIZE INTO S FIELD
	IOR A,[POINT 0,FOWORD]	;POSITION TO BEGINNING OF WORD
	MOVEM A,FOBPT
	PUSHJ P,GETFI0		;GET ANOTHER WORD
	 POPJ P,		;ERROR RETURNS
	 JRST CPOPJ1
	MOVEM A,FOWORD		;SAVE FILE WORD FOR BYTE EXTRACTION
	MOVEI A,=36		;INIT BITS LEFT
GETFI4:	SUB A,DOBS		;SUBTRACT BYTE SIZE FROM BITS LEFT IN WORD
	MOVEM A,FOBTSL
	JUMPL A,GETFI5		;JUMP IF NOT ENOUGH
	ILDB A,FOBPT		;THIS IS AN EASY ONE
	JRST CPOPJ2

GETFI5:	PUSHJ P,GETFI0		;WRAPAROUND CASE, GET NEXT WORD
	 POPJ P,
	 JRST CPOPJ1
	MOVEM A,FOTEMP		;SAVE NEXT WORD
	MOVE B,A		;POSITION FOR LSHC
	MOVE A,FOWORD
	MOVN D,FOBTSL		;*** NOTE WE ARE USING AC D.  C IS IN USE UPLEVEL.
	LSHC A,(D)		;POSITION COMBINATION BYTE
	AND A,FOMASK		;FLUSH CRUFT
	MOVE B,FOTEMP
	MOVEM B,FOWORD		;SET UP FOR NEW WORD
	MOVEI B,=36
	ADDB B,FOBTSL
	LSH B,6			;MAKE NEW BPT
	ADD B,DOBS
	LSH B,=24
	HRRI B,FOWORD
	MOVEM B,FOBPT
	JRST CPOPJ2

GETFI6:	SKIPE DOTYPE		;DONE EXCEPT FOR ASCII MODE
	JRST CPOPJ2
	JUMPE A,GETFIL		;FOR ASCII, WE FLUSH NULLS
	MOVE B,@FOBUF+1		;  CHECK FOR SOS LINE NUMBERS
	TRNN B,1
	JRST GETFI7
	MOVNI B,5
	ADDM B,FOBUF+2
	AOS FOBUF+1
	JRST GETFIL

GETFI7:	AOSE NOEDIR		;  CHECK FOR E DIRECTORY
	JRST GETFI8
	MOVE D,FOBUF+1
	MOVE B,(D)
	CAME B,[ASCII /COMME/]
	JRST GETFI8
	MOVE B,1(D)
	CAME B,[ASCII /NT ⊗ /]
	JRST GETFI8
	MOVE B,2(D)
	CAME B,[ASCII /  VAL/]
	JRST GETFI8
GETF71:	PUSHJ P,GETFIL
	 POPJ P,
	 JRST CPOPJ1
	CAIE A,14
	JRST GETF71
	JRST GETFIL

GETFI8:	CAIN A,175		;  AND TRANSLATE THE FUNNY ONES
	MOVEI A,33		;ALTMODE
	CAIN A,176
	MOVEI A,175		;RIGHT BRACE
	CAIN A,32
	MOVEI A,176		;TILDE
	JRST CPOPJ2

FOBTSL:	0
FOWORD:	0
FOBPT:	0
FOTEMP:	0
FOMASK:	0
>;repeat 0
;NUMPR NUMPR1 DON0 DATGEN NODA1 ONEDDD NODATE NOTIME NOZON MONTAB PDDATE PSDATE DTKIND

; OUTPUT IS TO DISK FILE
DEFINE STROUT(X) <
	MOVEI B,X
	PUSHJ	P,WRTSTR
>
DEFINE OUT1 (X) <MOVE A,X ↔ XCT OUTINSTR>
DEFINE PRNUM(X,N) <
    IFN X-T2,<MOVE T2,X	;arranged to be ok for this routine,
				; to clobber T2 whenever prnum called>
    PUSHJ P,NUMPR		;ok to generate multiple words
    N				; in PRNUM -- this is min width
>;PRNUM

   NUMPR:PUSH	P,T1
	MOVE	T1,@-1(P)
	PUSHJ	P,NUMPR1
	POP	P,T1
	AOS	(P)	
	POPJ	P,

   NUMPR1:IDIVI	T2,=10
	IORI	T3,"0"
	HRLM	T3,(P)
	SUBI	T1,1
	JUMPE	T2,.+2
	PUSHJ	P,NUMPR1
	JUMPLE	T1,DON0
	OUT1	(["0"])
	SOJG	T1,.-1
   DON0:HLRZ	T2,(P)
	OUT1	T2
	POPJ	P,

; THE DATGEN ROUTINE

DATGEN:	DATE	T1,
	IDIVI	T1,=31
	ADDI	T2,1
	PUSH P,T2
NODA1:	IDIVI	T1,=12	
	MOVEI T3,261			;DAYLIT
	PEEK T3,
	PEEK T3,
	SKIPE T3
	 SKIPA T3,[PDDATE]
	  MOVEI	T3,PSDATE
	MOVEM	T3,DTKIND
	MOVEI B,@MONTAB(T2)
	PUSHJ P,WRTSTR
	POP P,A
	IDIVI A,=10
	JUMPE A,ONEDDD
	ADDI A,"0"
	XCT OUTINSTR
ONEDDD:	MOVEI A,"0"(B)
	XCT OUTINSTR
	MOVEI B,[ASCIZ/, /]
	PUSHJ P,WRTSTR
	MOVEI	T2,=1964(T1)
	PRNUM	(T2,2)
	STROUT ([ASCIZ/ /])
NODATE:	MSTIME	T2,
	IDIVI	T2,=1000*=60
	IDIVI	T2,=60
	MOVE	T1,T3
	PRNUM	(T2,2)
	MOVE	T2,T1
	PRNUM	(T2,2)
NOTIME:	STROUT	(@DTKIND)
NOZON:	POPJ P,

MONTAB:	[ASCIZ/January /]
	[ASCIZ/February /]
	[ASCIZ/March /]
	[ASCIZ/April /]
	[ASCIZ/May /]
	[ASCIZ/June /]
	[ASCIZ/July /]
	[ASCIZ/August /]
	[ASCIZ/September /]
	[ASCIZ/October /]
	[ASCIZ/November /]
	[ASCIZ/December /]
PDDATE:	ASCIZ/ PDT/
PSDATE:	ASCIZ/ PST/
DTKIND:	0
;ILEVEL DNTSAY timout SXACTV LOOK

;	INTERRUPT LEVEL ROUTINE

ILEVEL:	MOVE	A,JOBCNI
   ifn iverbose, <
	PTOCNT	LOOK
	MOVE	b,LOOK+1
	CAILE	b,120		;make sure plenty of room in output buffer
	 JRST	 DNTSAY		;not enough room, avoid I-level schedule attempt
	outchr	["↔"]
	tlne	a,intinp
	outchr	["p"]
	tlne	a,intims
	outchr	["s"]
	TLNE A,INTINS
	OUTCHR ["A"]
   >;ifn iverbose
DNTSAY:	tlne a,intclk
	jrst timout
;;	TLNE A,INTINS
;;	SOS SYNCH		;IF THIS GOES NEGATIVE WE STOP TILL IT CATCHES UP
	TLNE A,INTINS
	SETZM CIHUNG		;PREPARES US FOR A COMMAND AT ONCE (BETTER BE ABOR)
	TLNE	A,INTIMS
	SETOM	SCHEKF		;Status CHEcK Flag
	MOVE	A,[-3]
	MOVEM	A,XACTV
	DISMIS

timout:	debreak
	jrst errkil

SXACTV:	PUSH	P,[-3]		;HANDY ROUTINE TO SET XACTV
	POP	P,XACTV		;  WITHOUT CLOBBERING ANY
	POPJ	P,		;  ACCUMULATORS

ifn iverbose, <
LOOK:	0↔0
>
;⊗ GETHNM CPYHST CPYDUN HSTTAB HSTSIX WHYWHY

SUBTTL HOST NAME MAGIC USING NETWRK

GETHNM:
BEGIN NETHAK
	PUSH P,A
	SKIPN HSTADR		;maybe already mapped
	PUSHJ P,MAPHST		;get host table mapped in
	MOVE 0,HOSTNO		;get number of host we're connected to
	PUSHJ P,HSTNUM		;convert to name
	 JRST [	MOVEI 1,HSTSTR	;Failed, make NETWRK put number in HSTSTR for us
		PUSHJ P,HNUMST
		JRST CPYDUN]
	PUSH P,1		;save ptr to name
	HRLI 1,440700
	MOVE 2,[440700,,HSTSTR]
CPYHST:	ILDB 0,1
	IDPB 0,2
	JUMPN 0,CPYHST
	POP P,1			;ptr to name, for SETANM
CPYDUN:	PUSHJ P,SETANM		;change our Alias to indicate foreign host
;;;	PUSHJ P,UNMHST	;don't unmap, so that MLNMFF can use host table
	POP P,A
	POPJ P,

;Now preparation for inserting NETWRK.
HSTTAB←←1	;indicate to NETWRK we want host table
HSTSIX←←1	;also want code to generate alias from host name
IFN FTIP,<ERRTNS←←1> ;Also get error routine

WHYWHY:	0			;unused, but ref'd by NETWRK's HSTDED (not called)

.INSERT NETWRK.FAI[S,NET]
INTERN HSTNAM,HSTNXA,HSTADR
BEND NETHAK
;⊗ BYE BYE1 BYE2 ERRKIL QUIT QUIT1 ABOR FLUSH NEWTMO NOIMP UFLUSH GREET GREETL GREET0 NOFLAK GREET1 SAYWHO

;	MISCELLANEOUS ERROR MESSAGES	ERRKIL, BYE, QUIT, FLUSH, ABOR, GREET

BYE:	PUSHJ	P,FLUSCS		;THE COMMAND
BYE1:	SKIPN	DIACTV			;IF I/O ACTIVE, CAN'T QUIT YET
	SKIPE	DOACTV
	JRST	[SKIPE QUITNG		;GIVE INTERIM MESSAGE BUT ONCE
		  POPJ P,
		 SETOM QUITNG#		;THIS IS HOW
		 PUSHJ P,IMPSTR
		 ASCIZ /500 I'll split just as soon as the current transfer is done.
/
		 POPJ	P,]
BYE2:	PUSHJ	P,IMPSTR
	ASCIZ	/221 CUL
/
ERRKIL:	MTAPE IMP,NEWTMO		;Order of RELEASing changed to insure
	RELEASE	IMP,			;at least the control link gets closed.
	PUSHJ P,FLUSH			;FLUSH ALL DATA I/O
	MOVE	A,['KILL-2']
	MOVEM	A,KFLAG
QUIT:	RELEASE FIMP,3			;IN CASE OF MAIL ABORT
	SETZM PRIVS			;PARANOID?  ME, PARANOID?
	RESET				;IF ATTACHED TO A TERMINAL,
	SETZM HSTADR		;no host table mapped in now, since JOBFF reset
	MOVNI	B,1			; START OVER (TEST AGAIN
	GETLIN	B			; IN CASE IT'S CHANGED).
	AOJN	B,QUIT1
	EXIT

QUIT1:	OUTSTR [ASCIZ /Starting over
/]
	JRST START


ABOR:	SETZM DIACTV			;FLUSH ALL ACTIVITY
	SETZM DOACTV
;	SETZM DIHUNG			;AND RESET COROUTINES
;	SETZM DOHUNG
	PUSHJ P,IMPSTR			;BARF SO WHAT IF SCARCE RESOURCE
	ASCIZ /250 El grande de grosse RSET
/
	PUSHJ P,FLUSH
	SETZM GOTFRM		;forget any From: line seen
	JRST REGO			;RESET ALL ACTV, HUNG, AND PDLS

FLUSH:	RELEASE FIMP,3			;(The other mtapes get unassigned I/O
	RELEASE	FOMP,3			;sometimes)
;;	CHNSTS DIMP,A			;FIXING ABOVE LOSS
;;	TRNE A,400000
;;	MTAPE DIMP,NEWTMO
;;	RELEASE	DIMP,
;;	CHNSTS DOMP,A			;FIXING ABOVE LOSS
;;	TRNE A,400000
;;	MTAPE DOMP,NEWTMO
;;	RELEASE DOMP,
	POPJ P,

NEWTMO:	17
	BYTE (6) 2,24,24,7,7

NOIMP:	MES(CANNOT INIT IMP)
	JRST	ERRKIL

UFLUSH:	PUSHJ P,PUTBUF		; EXCRETE MESSAGE
	MOVEI B,5
	SLEEP B,
	JRST QUIT

GREET:
	MOVE E,[-LOURH3,,OURH3]	;aobjn ptr to list of our host nbrs
	MOVE B,HOSTNO		;get nbr of foreign host
GREETL:	CAMN B,(E)		;is this one of our host nbrs?
	JRST GREET0		;host nbr is ours, let us in even if system down
	AOBJN E,GREETL		;no, check other numbers
	MOVEI B,254			; MAINTMODE
	PEEK B,
	PEEK B,
	JUMPE B,GREET0
	PUSHJ P,IMPSTR
	 ASCIZ/421- /
	PUSHJ P,IMPSTH		;output our host name (SU-AI, S1-A, ...)
	PUSHJ P,IMPSTR
	 ASCIZ/ WAITS SMTP Server at /
	MOVE B,[PUSHJ P,PUTCH1]		;OUT INSTR FOR DATGEN -- NOT
	MOVEM B,OUTINSTR		; A SCARCE RESOURCE YET
	PUSHJ P,DATGEN
	PUSHJ P,IMPSTR
	 ASCIZ\
421 Sorry, the system is being debugged.  Try again later.
\
IFN FTIP,<
	OUTSTR [ASCIZ/MaintMode: Refusing /]
	PUSHJ P,SAYWHO
>;IFN FTIP
	JRST UFLUSH

GREET0:	PUSHJ P,IMPSTR
	 ASCIZ/220-/
	PUSHJ P,IMPSTH		;output our host name (SU-AI, S1-A, ...)
	PUSHJ P,IMPSTR
	 ASCIZ/.ARPA WAITS SMTP Server at /
	MOVE B,[PUSHJ P,PUTCH1]		;OUT INSTR FOR DATGEN -- NOT
	MOVEM B,OUTINSTR		; A SCARCE RESOURCE YET
	PUSHJ P,DATGEN
	MOVEI B,256			; LASTDISASTERTIME
	PEEK B,
	PEEK B,
	JUMPE B,NOFLAK
	ACCTIM A,
	SUB A,B
	TLZE A,1			;FORGIVE ONE DAY
	 ADDI A,=24*=60*=60
	CAILE A,=15*=60
	 JRST NOFLAK
	PUSHJ P,IMPSTR
	 ASCIZ/
220-The system is misbehaving.  Proceed with caution!/
NOFLAK:	MOVEI B,254			; MAINTMODE
	PEEK B,
	PEEK B,
	JUMPE B,GREET1
	PUSHJ P,IMPSTR
	 ASCIZ/
220-The system is being debugged./
GREET1:	PUSHJ P,IMPSTR
	ASCIZ\
220 Bugs/gripes to Bug-SMTP @ \
	PUSHJ P,IMPSTH		;output our host name (SU-AI, S1-A, ...)
	PUSHJ P,IMPSTR
	ASCIZ/.ARPA/
	PUSHJ P,IMPCR		;output crlf
	POPJ P,	

IFN FTIP,<
SAYWHO:	OUTSTR [ASCIZ /Connection from host /]
	PUSHJ P,GETHNM
	OUTSTR HSTSTR
	OUTSTR [ASCIZ/
/]
	POPJ P,
>;IFN FTIP

END START